COMMENT ⊗   VALID 00032 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	Outer Loop
C00010 00003	PLAY Block Processor (PINS)
C00015 00004	   More of PINS
C00020 00005	   'PLAYIT' GENERATES SAMPLES BY CALLING THE 
C00025 00006	UUOSER - User UUO service
C00028 00007	Error Handling Routines.
C00033 00008	IGNOLF:	CAIN 0,15
C00036 00009	Lookup External in DDT Symbol Table
C00037 00010	Unit Generators
C00044 00011	   ZOSCIL Family of Unit Generators
C00050 00012	   More generators, LINEN
C00054 00013	   Reverberation Unit Generators
C00061 00014	   Random Numbers
C00065 00015	FORTRASH Routines and Random Functions
C00069 00016	Extended Commands
C00071 00017	   More Command Routines.
C00074 00018	SMPOUT - Sample Output Buffer Routines
C00077 00019	PLINI2:	MOVEM F,PLYOPT	SAVE PLAY OPTION NUMBER
C00080 00020	EXTERNAL JOBJDA
C00083 00021	   Sound file headers
C00088 00022	   Routines to Make File Names, and Keep the System Happy
C00092 00023	   Sample Output Routines For Each Device
C00094 00024	Sample Buffer Tables, etc.
C00097 00025	SAVER
C00100 00026	Storage Management
C00103 00027	SIXOUT and PRTFLN
C00106 00028	RDBUF - READ A BUFFER
C00108 00029	Numeric Output Routines
C00112 00030	   Read number from TTY
C00120 00031	ENTRY WRIOSP			↔  TITLE WRIOSP ↔EXTERNAL WRSIX
C00125 00032	Tables and Flags
C00129 ENDMK
C⊗;
SUBTTL Outer Loop
; HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.

CHOWN1:	PUSHJ P,INTER1	;INTERPRET STATEMENT.
SCHOWN:	PUSHJ P,SMSC1	;GET FIRST NON-SEMICOLON.
	MOVE JOBREL
	MOVEM BEGFREE	;*****
	SUB JOBFF
	SKIPN GETMORE#	;DO WE NEED TO GET MORE?
	CAIGE =1024	;NO, DO WE HAVE AT LEAST 2K WORDS OF CORE?
	COREFULL	;COREFULL WILL KINDLY GET US SOME MORE
	SETZM GETMORE	;CLEAR CORE REQUEST FLAG
CHOWN:	CAMN A,PLAYV	;IS IT A 'PLAY' SECTION ?
	JRST PLAY1	;YES.
	CAMN A,ALTV	;IS IT AN ALT MODE ?
	JRST COMMND	;YES. A COMMAND FOLLOWS.
	CAMN A,EXTV	;AN EXTERNAL DECLARATION
	JRST CHOWN2	;YES, BETTER BE READY TO GENERATE CODE
	CAME A,INSV	;IS IT A INSTRUMENT DEFINITIN?
	CAMN A,FUNV	;A FUNCTION DEFINITION?
	JRST [CHOWN2:	PUSHJ P,SCOMP	;INIT. COMPILER
		SETZ H,
		PUSHJ P,(A)	;DO DEFINITION
		PUSHJ P,ENDP1	;CLEAN UP COMPILER
		PUSHJ P,LOADER	;LOAD DEFINITION
		JRST SCHOWN]
	TLNE A,DF	;IS IT A DECLARATION?
	TLNN A,DECLBIT
	JRST CHOWN1	;NO. JUST A STATEMENT.
	PUSHJ P,(A)	;DO DECLARATION
	CAMN A,SEMICV	;BETTER BE A SEMICOLON
	JRST SCHOWN	;GO BACK FOR MORE
	WARN(Missing ';')
	JRST CHOWN

;A COMPILE BLOCK
COMPL1:	PUSHJ P,SCOMP	;INIT. THE COMPILER.
	PUSHJ P,SCAN
COMPL2:	PUSHJ P,SMCS1	;SCAN TO NEXT SEMICOLON
	CAME A,FINV	;A FINISH?
	CAMN A,FINIV	;OR A 'FINI'?
	JRST COMPDN
	TLNE A,DF	;A DECLARATION?
	TLNN A,DECLBIT
	JRST [WARN <A simple statement inside a 'COMPILE' section just wastes space!>
COMMENT ⊗ It will never be executed. ⊗;
		PUSHJ P,STAT	;EAT IT ANYWAY...
		JRST COMPL3]
	PUSHJ P,(A)	;YES, DO IT
COMPL3:	CAME A,SEMICV	;BETTER BE A SEMICOLON
	WARN <Missing ';'>	;OH, WELL...
	JRST COMPL2

COMPDN:	PUSHJ P,ENDP1	;DONE WITH COMPILATION
	PUSHJ P,LOADER	;LOAD THE CODE.
	JRST SCHOWN	;DONE WITH THAT SECTION.

PLAY1:	SETZ A,
	RUNTIM A,
	MOVEM A,RUNTIM#	;SAVE FOR STATISTICS LATER
	TIMER A,
	MOVEM A,BEGTIM#
	PUSHJ P,PLINIT	;WE'RE GOING TO PLAY; GET SAMPLE BUFFER.
	AOS SBCNT
	LDB A,[POINT 6,SBPTR,11];Calculate maximum possible sample
	SETO 0,			;from byte size for output
	LSH 0,-1(A)
	SETCAM 0,OVRSMP#	;Remember it somewhere
PLAY1A:	SETZM TIME#	;T←0.
	SETZM RQPTR#	;RUN QUEUE IS EMPTY.
	SKIPN BLKNUM	;DON'T RESET MAXSMP IF APPENDING
	SETZM MAXSMP#	;INIT. THE MAXIMUM SAMPLE REMEMBERER.
PLAY2:	PUSHJ P,SMSC1	;SCAN A NON-SEMICOLON.
	CAMN A,FINIV	; A 'FINI'?
	JRST PTERM
	CAME A,FINV	;A 'FINISH ' ?
	CAMN A,PLAYV 	;... OR A 'PLAY' ?
	JRST PTERM	;YES. END OF SECTION.
	TLNE A,INSBIT	;AN INSTRUMENT NAME ?
	JRST PINS	;YES. A NOTE STATEMENT.
	PUSH P,[PLAY2]	;NO. INTERPRET THE STATEMENT.
INTER1:	CAME A,INSV
	CAMN A,FUNV
	ERROR <NOT ALLOWED IN 'PLAY' SECTION>
	PUSHJ P,SCOMPA	;IT MUST BE A RANDOM STATEMENT.
			;PREPARE TO INTERPRET IT BY
			;INITIALIZING THE COMPILER.
	SETOM IONLY	;DON'T GENERATE R-TIME CODE AS ATTEMPTS TO DO
			;SO CONFUSE THE COMPILER (SEE GM3)
	PUSHJ P,STAT	;COMPILE THE STATEMENT.

;INTERPET THE CODE JUST COMPILED
INTERP:	MOVE A,[JRST INTER2]	;PREPARE TO EXECUTE TEMPORARY
	MOVEI B,0	;CODE (I.E., RUN IN INTERPRET MODE).
	PUSHJ P,@EMITB(H);EMIT RETURN INSTR. AT END OF CODE.
	PUSHJ P,ENDP1	;CLEAN UP COMPILER.
	PUSH P,JOBFF	;SAVE FREE STG. PTR.	*****
	PUSHJ P,LOADER	;LOAD THE TEMPORARY CODE.
	MOVEM P,PSV1#	;SAVE IT.
	MOVEM FL,FLSV1#
	JRST @(P)	;EXECUTE IT.
INTER2:	MOVE P,PSV1	;RESTORE PUSHDOWN POINTER.
	MOVE FL,FLSV1
	POP P,0		;RETRIEVE OLD STG. PTR.
	HRRZM JOBFF	;FLUSH THE TEMP. CODE.	*****
	HRLM JOBSA	;(IT HAS TO GO HERE TOO.)	*****
	POPJ P,		;LOOK, MA, I'M AN INTERPRETER !!
SUBTTL PLAY Block Processor (PINS)
;THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
; INSTRUMENT, AND GETS IT TURNED ON AT THE RIGHT TIME.

PINS:	MOVE A,(A)	;GET STARTING ADDRESSES FOR INSTRUMENT.
	PUSH P,(A)	;SAVE THEM.
	MOVEI PBASE	;PREPARE TO FILL THE P ARRAY WITH
	MOVEM PPTR1#	;THE PARAMETERS TO THE INSTR.
	PUSHJ P,SCOMPA	;INIT. COMPLR. FOR POSSIBLE EXPRESSIONS.
	MOVE NCHNS	;GET NO. OF OUTPUT CHANNELS.
	TLNE -1		;IS IT FLOATING ?
IFE KI10SW,<	KAFIX 0,233000	>
IFN KI10SW,<	KIFIX 0,0	>
PINS2:	MOVEM I.NCHNS#
	PUSH P,NUMBUC	;SAVE CURRENT STATE OF NUMBER
	PUSH P,JOBFF	;BUCKET AND CORE TOP.	*****
	JRST PINSL	;INIT. THE COMPILER.


PINSL1:	CAMN A,COMMAV	;OPTIONAL COMMA BETWEEN PARAMS...
PINSL:	PUSHJ P,SCAN
	AOS PPTR1	;INCREMENT P-ARRAY POINTER.
	CAMN A,COMMAV	;A COMMA HERE MEANS MISSING
	JRST PINSL	;PARAM., SO DON'T CHANGE.
	CAMN A,SEMICV	;SEMICOLON ?
	JRST PINSB	;YES, END OF PARAMETERS.
	TLNE A,SWVBT	;IS IT AN ARRAY NAME?
	JRST [	PUSH P,A	;SAVE ARRAY NAME
		PUSHJ P,SCAN	;PEEK AT NEXT ELEMENT
		CAME A,LPARV	;IS IT A LEFT PAREN?
		CAMN A,LFTBRK	;Or left bracket?
		JRST [	MOVEM A,SNCHR	;Yes, evaluate it. (SNCHR FOR USE BY EXPR)
			POP P,A		;RESTORE THE ARRAY NAME AND COMPILE AN EXPR
			JRST PINSL2]
		;THE ABOVE IS NOT SUFFICIENTLY GENERAL BUT WILL WORK WITH
		;EXISTING FUNCTIONS AND UNIT GENERATORS
		POP P,B		;NO, RESTORE THE ARRAY NAME
		HRR B,(B)	;GET ITS ADDRESS
		HRLI B,INSXR	;TURN ON APPROPRIATE INDEX REGISTER
				;FOR UNIT GENERATOR
		MOVEM B,@PPTR1	;SAVE IT
		JRST PINSL1]	;AND USE AS FORMAL PARAMETER
PINSL2:	PUSHJ P,EXPR	;PARAMETER MAY BE EXPRESSION.
	PUSH P,A	;SAVE SCANNED SYMBOL
	PUSHJ P,GPONDER	;GET OPERAND POINTER FOR THE EXPR...
	TLNE T,SIACBT	;IS VALUE OF EXPR AN AC SYMBOL ?
	JRST PINS1	;YES. IT HAS TO BE CALCULATED.
	TLNE T,ARRYBT	;Is it an array reference?
	TLNN T,17	;  Yes, if an index is given.  Then evaluate it!
	JRST PINSL4	;No, prob. just variable
	PUSH P,T	;Emit instruction to get it into an AC
	PUSHJ P,GETAC	;Find an AC to put it in
	POP P,B		;Will fix array element
	MOVE C,[MOVE EMICDI]
	PUSHJ P,EMINST	;Emit MOVE
	JRST PINSA2	;Then have it stored in P-ARRAY
PINSL4:	POP P,A		;RESTORE SCANNED SYMBOL
PINSL3:	MOVE C,(T)	;PICK UP ITS VALUE.
	MOVEM C,@PPTR1	; SO PUT ITS VALUE IN P-ARRAY NOW.
	JRST PINSL1
PINS1:			;EXPR. GENERATED SOME CODE, EVIDENTLY.
	MOVE A,T	;EMIT AN INSTRUCTION TO STORE THE
PINSA2:	MOVE B,PPTR1	;RESULTANT VALUE IN THE P-ARRAY.
	MOVE C,[MOVEM EMICDI]
	PUSHJ P,EMINST	;THE CODE WILL GET EXECUTED 
	PUSHJ P,INTERP	; RIGHT NOW.
	PUSHJ P,SCOMPA
	POP P,A		;RESTORE SCANNED SYMBOL
	JRST PINSL1	;BACK FOR MORE PARAMS.
;   More of PINS

PINSB:
 	POP OSP,BEGFREE	;FLUSH COMPLR. OUTPUT BUFFERS.	*****
	POP P,0		;RECOVER OLD CORE TOP.
	MOVEM JOBFF	;RESET THINGS TO FORGET		*****
	HRLM JOBSA	;ABOUT THE NUMBERS WE DEFINED WHILE *****
	POP P,NUMBUC	;SCANNING NOTE PARAMETERS.
 
	MOVE A,SRATE	;GET NO. OF SAMPLES/SEC.
	MOVE B,PBASE+1	;GET STARTING TIME FOR NOTE.
	FMPR B,A	;CONVERT TO SAMPLES.
	FIXR B,B  
	MOVEM B,RQ1	;PLACE AT BOTTOM OF RUN QUEUE.
	FMPR A,PBASE+2	;GET DURATION OF NOTE IN SAMPLES.
	FIXR A,A
	ADD A,B		;CALC. ENDING TIME OF NOTE.
	PUSH P,A	;SAVE SAME.
	PUSHJ P,PLAYIT	;PLAY UP TO STARTING TIME OF NOTE.
PLYON:	AOS A,RQPTR	;NOW TURN INSTRUMENT ON.
	POP P,RQ1(A)	;PUT ENDING TIME IN RUNQUEUE, COL. ONE.
	HLRZ T,(P)	;LET'S CHECK TO SEE IF HE'S TRYING TO RUN THE SAME
	MOVEM T,LSTINS#
	MOVE T,A	;INSTRUMENT AT THE SAME TIME!
PLYON2:	SOJL T,PLYON3	;TEST FOR END OF SEARCH
	HRRZ RQ2(T)
	CAME LSTINS	;IS IT THE SAME?
	JRST PLYON2	;NO
	WARN (You are calling an instrument which is already running!)
COMMENT ⊗ Since the code generated for instruments is non-reentrant,
you should not call it with overlapping time periods as this will 
produce unpredicable results.  Instead you should make a copy of with
a different name (and different variable names if they are declared outside
that instrument). ⊗;
PLYON3:	POP P,T		;GET STARTING ADDR. OF INSTRUMENT.
	HLRZM T,RQ2(A)	;PLACE IN RUN QUEUE, COL. TWO.
	PUSHJ P,(T)	;EXECUTE THE I-TIME CODE.
	JRST PLAY2	;BACK FOR MORE NOTE STATEMENTS.

DSKDAC:	1

PTERM:	PUSH P,A	;HERE AT A 'PLAY' OR 'FINISH'.
	MOVSI 200000
	MOVEM RQ1	;SET UP FAKE STARTING TIME.
	PUSHJ P,PLAYIT	;FLUSH THE RUN QUEUE.
	POP P,A		
	CAMN A,PLAYV	;WAS IT A 'PLAY' THAT WE SAW ?
	JRST PLAY1A	;YES. START NEW SECTION.
	MOVE F,PLYOPT
	PUSHJ P,@FINTAB(F);NO, A 'FINISH'. EMPTY THE LAST BUFFER
IFE KI10SW,<	MOVE A,BITS
		KAFIX A,233000	>
IFN KI10SW,<	KIFIX A,BITS	>
	TYPSTR [ASCIZ/   Bits = /]
	PUSHJ P,DECPNT
IFE KI10SW,<	MOVE A,SRATE
		KAFIX A,233000	>
IFN KI10SW,<	KIFIX A,SRATE	>
	TYPSTR [ASCIZ/  Srate = /]
	PUSHJ P,DECPNT
	TYPSTR[ASCIZ/
	/]
	SETZ A,
	RUNTIM A,
	SUB A,RUNTIM
	FSC A,233
	FDVRI A,(1000.0)	;CONVERT RUN TIME TO SECONDS
	MOVEM A,RUNTIM
	PUSHJ P,OUTFLT
	TYPSTR [ASCIZ/Seconds run time	  /]
	TIMER 0,
	SUB 0,BEGTIM
	FSC 0,233
	FDVRI 0,(60.0)
	MOVE A,RUNTIM
	FDVR A,0
	FMPRI A,(100.0)
	PUSHJ P,OUTFLT
	MOVEI [ASCIZ/% PL	  1:/]
	JSR TXTOUT
	MOVE 0,TIME
	FSC 0,233
	FDVR 0,SRATE
	MOVE A,RUNTIM
	FDVR A,0
	PUSHJ P,OUTFLT
	MOVEI [ASCIZ/Compute ratio/]
	JSR TXTOUT
	SKIPE SAVCNT
	TYPSTR [ASCIZ/
***** PLEASE DELETE .SAV FILE *****/]
	OUTPUT TTY,	;FLUSH THE OUTPUT BUFFER
	TYPSTR[ASCIZ/
/]
DACLP:	JRST CPLAY		;  Yes, do it
;   'PLAYIT' GENERATES SAMPLES BY CALLING THE 
;   INSTRUMENTS IN THE RUN QUEUE UNTIL IT IS TIME
;   TO TURN ON THE INSTRUMENT WHOSE STARTING TIME IS
;   IN THE ZEROTH LOCATION OF THE QUEUE, WHEN IT RETURNS.
;   INSTRUMENTS ARE TURNED OFF AS REQUIRED.

IOACT←←10000	;BIT IN DDB INDICATING I/O ACTIVE

PLAYIT:	MOVE A,RQPTR	;SEARCH FOR EARLIEST TIME IN QUEUE.
PLYT2:	MOVEM A,PTMP#	;SAVE ITS LOCATION.
	SKIPA H,RQ1(A)	;PICK IT UP.
	CAMG H,RQ1(A)	;A NEW MINIMUM ?
	SOJGE A,.-1	;NO.
	JUMPGE A,PLYT2	;YES.
PLYT1:	CAMN H,[XWD 200000,0]	;MIN. FOUND. IS IT THE TERMINATION
	POPJ P,		; MARK ? IF YES, THEN RETURN.
	SUB H,TIME	;IT'S NOT . CALC. DISTANCE IN FUTURE.
	JUMPLE H,PLYT3	;IF NOT IN FUTURE, FORGET IT.
	ADDM H,TIME	;MOVE TIME TO NEW VALUE.
PLYT4:	SKIPE OSP,RQPTR	;CYCLE THRU RUNNING INSTRS., IF ANY.
	PUSHJ P,@RQ2(OSP)	;CALL AN INSTR.
	JFCL 1,.+1
	SOJG OSP,.-2	;CALL THEM ALL.
	MOVEI F,1	;START WITH CHANNEL 1.
PLYT5:	SOSLE SBCNT	;COUNT SAMPLE BUFFER COUNTER.
	JRST .+4
	EXCH F,PLYOPT	;SAVE F AND SET OPTION
	PUSHJ P,@OUTTAB(F);FLUSH FULL BUFFER.
	EXCH F,PLYOPT	;SAVE OPTION AND RESTORE F
	MOVE B,OUTA-1(F)		;PICK UP NEXT CHANNEL'S SAMPLE, AND
IFE KI10SW,<
	FAD B,[0.5]	;ROUND TO NEAREST INTEGER.
	KAFIX B,233000	;A. KOTOK SHOULD HAVE DONE THIS.
>;IFE KI10SW
IFN KI10SW,<
	FIXR B,B	;It's about time (and it isn't even as good)
>;IFN KI10SW
	CAIN B,400000	;DON'T OUTPUT TRAILER CODE
	ADDI B,1	;IT'S TOO SMALL ANYWAY...
	MOVM A,B	;GET MAGNITUDE...
	CAMLE A,MAXSMP	;IS THIS SAMPLE THE BIGGEST YET ?
	JRST [	CAMLE A,OVRSMP		;Check for larger than byte size
		JRST [	OUTSTR[ASCIZ/Channel /]
			MOVE A,F
			PUSHJ P,DECPNT
			OUTSTR[ASCIZ/ Value /]
			MOVE A,OUTA-1(F)
			PUSHJ P,OUTFLT
			WARN<OUTn too big, clipped>	;Tell loser about it
COMMENT ⊗ Sample just computed was too big to represent in the byte size
currently being used for output. This usually is indicative of some
problem in an instrument. ⊗;
			JUMPL B,[MOVN B,OVRSMP
				 MOVNM B,MAXSMP
				 JRST .+1 ]
			MOVE B,OVRSMP
			MOVEM B,MAXSMP
			JRST .+1]		;And let him continue
		MOVEM A,MAXSMP		;A new MAXSMP
		JRST .+1 ]
	IDPB B,SBPTR	;PLACE IT IN SAMPLE BUFFER.
	SETZM OUTA-1(F)	;ZERO UP THIS CHANNEL'S NEXT SAMPLE
	CAMGE F,I.NCHNS	;LAST CHANNEL ?
	AOJA F,PLYT5	;NO. GET OTHER CHANNELS.
	MOVE A,@MTSYSA	;GET WORD TO SEE IF WE WANT TO 'INTERRUPT` TO 
	SOJG H,PLYT4	;GENERATE REST OF SAMPLES.

PLYT3:	SKIPG A,PTMP	;GET PTR. TO NEXT INSTR. OFF OR ON.
	POPJ P,		;TIME TO TURN ONE ON.
	SOS B,RQPTR	;REMOVE INSTR. FROM QUEUE.
	MOVE RQ1+1(B)	;MOVE TOP ENTRY DOWN INTO VACANT
	MOVEM RQ1(A)	;SPOT.
	MOVE RQ2+1(B)
	MOVEM RQ2(A)	
	JRST PLAYIT	;GO PLAY TILL NEXT EVENT.
SUBTTL UUOSER - User UUO service
	BEGIN UUOSER
;Caution:  UUO's called by error routine better not use UUOPDL!!!
↑UUOSER: 0
	SETOM INUUO
	MOVEM P,SAVEP#
	LDB P,[POINT 6,40,8]	;GET OPCODE
	CAIG P,UUOMAX
	JUMPGE P,@UUOTAB(P)
UUOERR:	MOVE P,UUOIOWD
	PUSH P,UUOSER
	OUTSTR [ASCIZ/?ERROR
ILLEGAL USER UUO AT /]
	SOS A,UUOSER
	HRRZ A,A
	PUSH P,A
	PUSHJ P,OUTOCT
	OUTSTR [ASCIZ/
↑C/]
	CALLI 1,12
	MOVE P,SAVEP
	SETZM INUUO
	POPJ P,

UUORET:	MOVE P,SAVEP
	SETZM INUUO
	JRSTF @UUOSER

;TYPCHR AND TYPSTR --- TYPE A CHARACTER AND TYPE A STRING
↑.TYPCHR: MOVE P,@40		;THESE ARE SO THAT A DIFFERENT DEVICE
	 SOSGE TOB+2		;THAN TTY COULD BE USED.
	 OUTPUT TTY,
	 IDPB P,TOB+1
	 JRST UUORET
↑.TYPSTR: MOVEI P,440700
	 HRLM P,40
TYPST2:	 ILDB P,40
	 JUMPE P,[ OUTPUT TTY,
		   JRST UUORET]
	 SOSGE TOB+2
	 OUTPUT TTY,
	 IDPB P,TOB+1
	 JRST TYPST2

↑.ERRUUO:MOVE P,SAVEP
BEND UUOSER
	 JSR SAVE
	 MOVE P,UUOIOWD
	 LDB 15,[POINT 4,40,12]
	 CAILE 15,11
	 SETZ 15,
	 OUTSTR@[[ASCIZ/Dryrot:	/]	;0
		 [ASCIZ/Error:	/]	;1
		 [ASCIZ/Warn:	/]	;2
		 [ASCIZ/Warn:	/]	;3
		 [ASCIZ/Unexpect error, may be problem with system:	/]	;4
		 [ASCIZ/Dryrot:	/]	;5	;UNDEFINED AC FIELD
		 [ASCIZ/Dryrot:	/]	;6	;UNDEFINED AC FIELD
		 [ASCIZ/Dryrot:	/]	;7	;UNDEFINED AC FIELD
		 [ASCIZ/Debug:	/]	;10
		 [ASCIZ/Debug:	/]	;11
		](15)
	 OUTSTR @40
	 SETOM INERR#
	 MOVE 1,UUOSER
	 SETZM INUUO
	 MOVEM 1,ERRPC
ERR7:	 JSR ERR2
	 CAIN 15,3	;Skip warning?
	   AOSA ERRPC
	 CAIN 15,2	;Non-skip warning
	   TDZA 15,15
	 SETO 15,
	 MOVEM 15,WARNFL#
	 JSR RESTORE
	 SETZM INUUO
	 JRST ERR99

UUOPDL:	BLOCK 20
UUOIOW:	IOWD .-UUOPDL,UUOPDL

SUBTTL Error Handling Routines.

EXTERNAL JOBOPC

INTEGER INUUO,INERR,LINCNT,PAGCNT,LINENO,NXTPAG,NXTLIN,ERRPC
;INTEGER INUUO,INERR,LINCNT,PAGCNT,LINENO,NXTPAG,NXTLIN,NOMSG,ERRPC,IWARN
COMMENT ⊗
↓INUUO:	 0
↓LINCNT: 0
↓PAGCNT: 0
↓LINENO: 0
↓NXTPAG: 377777
↓NXTLIN: 377777
;↓NO.MSG: 0
;	 0	;TO TERMINATE OUTSTR
⊗;

ERR99:	MOVE 1,WARNFL
	OUTSTR @1+[[ASCIZ/??/]
		   [ASCIZ/→→/]
		   [0]
		   [ASCIZ/↔/]](1)
	SKIPG WARNFL	;GO DIRECTLY TO ERR96 IF NOT DEBUGGING
	JRST ERR96
	SOSN WARNFL	;DON'T STOP FOR DEBUG MODE 1
	JRST ERR97
ERR96:	CLRBFI		;CLEAR TTY INPUT BUFFER
	INCHWL 1
	CLRBFI
	CAIN 1,"α"
	JRST ERR97	;ALWAY CONTINUE!
	CAIL 1,"a"	;FOR LOWER CASE
	SUBI 1,40	;CONVERT TO UPPER CASE
ERR98:	CAIN 1,"S"	;RESTART?
	JRST GO		;YES, RESTART
	CAIN 1,"R"	;RETRY?
	JRST [RETRY:	MOVEI FL,RESTART
		MOVEI 1
		MOVEM RECCT	;SET USETI COUNT
		MOVEM PAGCNT	;SET PAGE COUNT
		MOVEM LINCNT	;SET PAGE COUNT
		PUSHJ P,SETUP	;USE SAME FILE
		SETZ FL,
		JRST GOB]	;DO RESTART
	SKIPL WARNFL	;CAN WE PROCEED
	CAIE 1,15
	JRST [	OUTSTR [ASCIZ/??/]
		OUTSTR [ASCIZ/
S = START PROGRAM AGAIN,  R = RETRY WITH SAME FILE./]
		JRST ERR96]
ERR97:	MOVE 1,ERSVAC+1
C.:
	SETZM INERR
	JRSTF @ERRPC	 
	0	

ERSVAC:	BLOCK 20
ERR2:	0	;ERROR MESSAGE PRINTER.
	OUTSTR [ASCIZ/	Line = /]
	MOVE A,LINCNT
	SKIPE LINENO
	OUTSTR LINENO	;FOR SOS FLAVOR OF LINE NUMBERS
	SKIPN LINENO
	PUSHJ P,OUTFLT
	OUTPUT TTY,
	OUTCHR ["/"]
	MOVE A,PAGCNT
	PUSHJ P,OUTFLT
	OUTSTR [ASCIZ/
/];
;   FIND OFFENDING LINE
	SKIPE NOISCP	;Check for ISCP invalid
	JRST ERR2Z
	MOVE A,ISCP	;SET UP THREE POINTERS TO BEGINNING OF TEXT BUFFER
	MOVE B,A	;TO BE USED TO FIND LINES PRECEDING ERROR
	MOVE C,B
ERR2B:	ILDB A		;SEARCH UNTIL <CR>
	CAIE 15
	JRST ERR2A
	MOVE C,B	;<CR> FOUND, NOW REMEMBER WHERE IT IS
	MOVE B,A
ERR2A:	CAME A,SCP	;WAS IT WHERE WE FOUND THE ERROR?
	JRST ERR2B	;NO, TRY AGAIN
	JRST ERR2D	;YES, LET'S PRINT IT, STARTING THE PREVIOUS LINE
ERR2C:	OUTCHR
ERR2D:	ILDB C		;GET A CHARACTER
	CAME C,SCP	;WAS IT WHERE THE ERROR WAS?
	JRST ERR2C	;NO, PRINT IT AN GET ANOTHER
	CAIE 14		;DON'T OUTPUT FORM FEED!
	OUTCHR		;PRINT IT TOO
ERR2E:	SKIPN (A)	;AT END OF BUFFER?
	JRST ERR2G	;YES
	ILDB A
	OUTCHR
	CAIE 15
	JRST ERR2E
ERR2G:	OUTSTR [ASCIZ/
/]
	CAMN B,SCP
	JRST ERR2H
ERR2F:	ILDB B		;NOW POINT TO ERROR
	CAMN B,SCP	;AT ERROR?
	JRST ERR2H	;YES, PRINT '↑` AND RETURN
	JUMPE ERR2F	;IGNORE NULLS
	CAIN 12
	JRST ERR2F
	CAIN 15
	JRST .+3
	CAIE 11		;A TAB?	
	MOVEI " "	;NO, OUTPUT A SPACE THEN
	OUTCHR
	JRST ERR2F	;NO, TRY AGAIN
ERR2H:	OUTCHR ["↑"]
ERR2Z:	OUTSTR [ASCIZ/
/]
	JRST @ERR2


;SAVE AND RESTORE ACS FOR ERROR ROUTINES
SAVE:	0
	MOVEM 17,ERSVAC+17	;SAVE AC'S
	MOVEI 17,ERSVAC
	BLT 17,ERSVAC+16
	MOVE 17,ERSVAC+17
	JRST @SAVE
RESTORE:0
	MOVSI 17,ERSVAC		;RESTORE AC'S.
	BLT 17,17
	JRST @RESTORE
IGNOLF:	CAIN 0,15
	INCHRS 0
	POPJ P,
	POPJ P,
;   Illegal array reference routine
;   PRINTS OUT ARRAY NAME AND SUBSCRIPT VALUE
ILLARF:	OUTPUT TTY,	;FLUSH TTY BUFFER
	OUTSTR [ASCIZ/
Subscript of out bounds for array /]
	JSR SAVE	;SAVE THE AC'S
	MOVE A,@(P)	;GET POINTER TO GOODBITS WORD
	PUSHJ P,PRNTSYM
	TYPSTR [ASCIZ/, subscript = /]
	JSR RESTORE
	PUSH P,A
	LDB A,[POINT 4,@-1(P),(17-5)]
	MOVE A,ERSVAC(A)
	POP P,(P)
ILLAR2:	PUSHJ P,OUTFLT
	SETOB 1,WARNFL
	JRST ERR99

;P array error
BADARR:	OUTPUT TTY,	;Flush TTY buffer
	ERROR <Array expected in function or U.G. call, but number found instead.
Prob. argument to instrument wrong.>
COMMENT ⊗ Either a function or Unit Generator was called with a Pn symbol, which
should have be an array, but instead a floating point number was found.  This
is usually caused by passing a number instead of an array in an instrument
call, or an error in the instrument with respect to the numbering of the
Pn arguments. ⊗;

SUBTTL Miscellaneous Cruft
UDIERR:	ERROR (Undefined IDENTIFIER)
SILCH:	WARN (Illegal character)
COMMENT ⊗ A character was found in file which has no meaning to the compiler. ⊗;
	POPJ P,		;I HOPE THIS WORKS, IT MIGHT NOT
SNUMX1:	ERROR (Illegal character in number);⊗ Not a digit or decimal point. ⊗;
FNDWV:	PUSHJ P,DRYROT
↑PI:	3.14159265359;*RANDOM CONSTANTS- IS THERE A BETTER PLACE FOR THIS?
;;.SKIP.↑: 0		;So as to avoid UNDEF EXTERNAL FROM FINC!

	FOR @$ A IN (PW,COMM,EXP,ENDS,WHLS)
	 <A$OP: PUSHJ P,DRYROT
	>

; ***  WHERE ELSE SHOULD THIS GO??  ***
; DECIDES IF A SYMBOL IS A PROPER STATEMENT TERMINATOR AND SKIPS IF
; IT IS NOT A TERMINATOR
STMTRM:	CAME A,SEMICV	;';`
	CAMN A,ENDV	;OR 'END`
	POPJ P,	
	CAME A,ELSEV	;OR 'ELSE`
	CAMN A,UNTILV	;OR 'UNTIL`
	POPJ P,
	AOS (P)
	POPJ P,
SUBTTL Lookup External in DDT Symbol Table
SYMSCH:	MOVEI T,6	;LOOK UP EXTERNAL SYMBOL.
	MOVE [POINT 6,ACCUM,5]	;PREPARE TO CONVERT TO
	MOVEI B,0
SYMS1:	ILDB A,0	;RADIX 50.
	JUMPE A,SYMS4
	CAIN A,16
	MOVEI A,73
	CAIG A,5
	ADDI A,70
	CAIGE A,32
	ADDI A,7
	IMULI B,50
	ADDI B,-26(A)
	SOJG T,SYMS1
SYMS4:	TLO B,40000
	MOVE A,116
SYMS3:	AOBJP A,SYMS2
	CAME B,-1(A)
	AOBJN A,SYMS3
SYMS2:	SKIPL A			;Is it present?
	  POPJ P,		;  No, non-skip return means failure
	HRRZ A,(A)		;Flush crud in left half
	AOS (P)			;Skip return for success
	POPJ P,
SUBTTL Unit Generators
;; HERE ARE SOME WONDERFUL UNIT GENERATORS.
	BEGIN U.G.

COMMENT ⊗
CALLED WITH:
	JSP RA,OSCIL
	<Amplitude>	;0 (-5)
	<Increment>	;1 (-4)
	<Array>(INSXR)	;2 (-3)
	<Temp - Sum>	;3 (-2)
⊗;
;;;↑OSCIL:	MOVE INSXR,3(RA)
;;;IFE KI10SW,<	KAFIX INSXR,233000	>
;;;IFN KI10SW,<	KIFIX INSXR,INSXR	>
IFE KI10SW,<
↑OSCIL:	MOVE INSXR,3(RA)
	KAFIX INSXR,233000	>
IFN KI10SW,<
↑OSCIL:	KIFIX INSXR,3(RA)   >
	TRZE INSXR,777000
	JSP T1,OSCIL1
	MOVE T,@2(RA)
	FMPR T,@(RA)
	SKIPGE T1,@1(RA)	;OSCIL DOESN'T WANT NEG. INC.
	JRST [	WARN (NEGATIVE INC. TO OSCIL)
COMMENT ⊗ OSCIL is not defined to go accept a negative increment however if
you continue from this error it will treat this increment as a NOSCIL does. ⊗;
		JRST OSCILX]
OSCILX:	FADM T1,3(RA)
	JRST 4(RA)

OSCIL1↑:MOVSI (-512.0)	;WRAP AROUND THE POINTER.
	JUMPGE INSXR,.+2
	MOVNS 0		;IF NEG. INC., WRAP AROUND OTHER WAY.
	FADM 3(RA)
;;	HRLI INSXR,0	;INSERTED 1/25/71 TO ALLOW ZOSCIL=NOSCIL
	JRST (T1)

↑NOSCA:	ADDI RA,1		;SEE  INOSCA
IFE KI10SW,<
↑NOSCIL:MOVE INSXR,3(RA)	;SAME AS OSCIL EXCEPT IT WILL TAKE NEG. INC
	KAFIX INSXR,233000	>
IFN KI10SW,<
↑NOSCIL:KIFIX INSXR,3(RA)	>
	TRZE INSXR,777000
	JSP T1,OSCIL1
	MOVE T,@2(RA)
	FMPR T,@(RA)
	MOVE T1,@1(RA)
	FADM T1,3(RA)
	JRST 4(RA)

IFE KI10SW,<
↑FOSCIL:MOVE INSXR,3(RA)	;FOSCIL=SLIGHTLY FASTER OSCIL
	KAFIX INSXR,233000	>
IFN KI10SW,<
↑FOSCIL:KIFIX INSXR,3(RA)   >
	TRZE INSXR,777000
	JSP T1,FSCIL1
;;	JRST FSCIL1
	MOVE T,@2(RA)
	FMPR T,@(RA)
	MOVE T1,@1(RA)	;FOSCIL HAS NO CHECK FOR NEG. INC.!!!!!!!
	FADM T1,3(RA)
	JRST 4(RA)
FSCIL1↑:MOVSI (-512.0)	;WRAP AROUND THE POINTER.
	FADM 3(RA)
  	JRST (T1)
;;	JRST FOSCIL

↑OUT:	0		;FUNCTION OUT(VALUE); BEGIN OUTA←OUTA+VALUE; END
	MOVE @(RA)	;PICK UP INPUT.
	FADM OUTA	;ACCUMULATE INTO OUTPUT ARRAY.
	POPJ P,		;RETURN FROM INSTRUMENT.

↑OUT2:	0		;FUNCTION OUT(X,CH1,CH2);
	MOVE @(RA)	;  BEGIN OUTA←OUTA+X*CH1; OUTB←OUTB+X*CH2; END
	MOVE 1,0
	FMP 0,@1(RA)
	FADM 0,OUTA	;
	FMP 1,@2(RA)
	FADM 1,OUTB
	POPJ P,

↑EXPEN:	MOVE INSXR,@1(RA)	;GET INCREMENT.
	FADB INSXR,3(RA)	;INCREMENT POINTER.
IFE KI10SW,<	KAFIX INSXR,233000	>
IFN KI10SW,<	KIFIX INSXR,INSXR	>
	CAIL INSXR,777	;IF GREATER THAN 511, STICK
EXPEN2:	MOVEI INSXR,777	;AT LAST ELEMENT OF ARRAY. (ALSO COMES HERE FROM ZEXPEN)
	MOVE T,@2(RA)	;GET ARRAY ELEMENT.
	FMPR T,@(RA)	;MULTIPLY BY AMPLITUDE.
	JRST 4(RA)	;RETURN.
COMMENT ⊗
CALLED WITH:
	JSP RA,VFMULT
	<Amplitude>		;0
	<Position>		;1
	<Array>(INSXR)		;2
⊗;
VFM2:	FSBR INSXR,[512.0]	;YOU MUST NOW SET PTR FOR VFMULT!
	MOVEM INSXR,@VFMULT
↑VFMULT: MOVE INSXR,@1(RA)	;GET POINTER INPUT.
	CAML INSXR,[512.0]
	JRST VFM2
IFE KI10SW,<	KAFIX INSXR,233000	>
IFN KI10SW,<	KIFIX INSXR,INSXR	>
	MOVE T,@2(RA)		;GET INDICATED ELEMENT OF ARRAY.
	FMPR T,@(RA)		;MULT. BY AMPLITUDE.
	JRST 3(RA)

COMMENT ⊗ NOSCA
	JSP RA,NOSCA
	<Initial sum>	;-1(-6)
	<Ampiltude>	;0 (-5)
	<Increment>	;1 (-4)
	<Array>(INSXR)	;2 (-3)
	<Temp - Sum>	;3 (-2)
⊗;
↑INOSCA: 0
	MOVE T,(RA)
	MOVE T1,@-6(T)
	MOVEM T1,-2(T)
	JRA RA,1(RA)

COMMENT ⊗ INTRP
	JSP RA,INTRP
	<Value 1>		;-1(-6)
	<Value 2>		;0 (-5)
	<Temp - Increment>	;1 (-4)
	<Array>(INSXR)		;2 (-3)
	<Temp - sum>		;3 (-2)
⊗;	
↑INTRP:	ADDI RA,1		;TO KEEP OSCIL1 HAPPY (CHANGE THIS SOMEDAY)
IFE KI10SW,<
	MOVE INSXR,3(RA)	;GET INDEX IN ARRAY
	KAFIX INSXR,233000	>
IFN KI10SW,<	KIFIX INSXR,3(RA)	>  	;MAKE AN INTEGER
	TRZE INSXR,777000	;DID IT WRAP AROUND?
	JSP T1,OSCIL1		;YES, BUT IT REALLY SHOULDN'T!!!!
	MOVE T,@2(RA)		;GET ARRAY ELEMENT
	MOVE @(RA)		;GET FIRST VALUE
	FSBR @-1(RA)		;SUBTRACT THE SECOND
	FMPR T,0		;MULIPLY ARRAY ELEMENT BY DIFFERENCE
	FADR T,@-1(RA)		;AND ADD THE FIRST VALUE
	MOVE T1,1(RA)		;NOW UPDATE THE SUM
	FADM T1,3(RA)
	JRST 4(RA)

↑IINTRP: 0
	MOVE T,(RA)		;GET INDEX TO ARGUMENT LIST
	MOVSI T1,(512.0)	;NOW CALCULATE THE INCREMENT BASED ON THE
	FDVR T1,SRATE		;DURATION OF THE NOTE
	FDVR T1,PBASE+2
	MOVEM T1,-4(T)		;SAVE IN ANOTHER TEMP
	JRA RA,1(RA)

;   ZOSCIL Family of Unit Generators
COMMENT ⊗ ZOSCIL - Called with
	JSP RA,ZOSCIL
	<Amplitude>	;0
	<Increment>	;1
	<Array>		;2
	<Zeroed-Sum>	;3
⊗;
↑ZOSCA:	ADDI RA,1
IFE KI10SW,<
↑ZOSCIL: MOVE INSXR,3(RA)	;ZOSCIL WORKS LIKE COSCIL AND NOSCIL!
	KAFIX INSXR,233000	>
IFN KI10SW,<
↑ZOSCIL:KIFIX INSXR,3(RA)	>  	;MAKE AN INTEGER
	TRZE INSXR,777000	;DID WE RUN OVER?
	JSP T1,ZOSCL1		;YES, DO WRAPAROUND
	MOVE T,@2(RA)		;PICK UP FIRST ELEMENT
	move insxr		;SAVE INDEX
	move t1,t		;COPY FIRST ELEMENT
	cain insxr,777		;ARE WE AT THE LAST ELEMENT
	tdza insxr,insxr	;YES, SET INDEX TO ZERO AND SKIP
	addi insxr,1		;NO, INCREMENT INDEX
	fsbr t1,@2(ra)		;GET DWFFERENCE IN VALUE I
	fsc 233			;(FLOAT THE INDEX)
	fsb 3(ra)		;GET DIFFERENCE IN INDEX INTO 0
	fmpr t1,0		;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
	fadr t,t1		;IS ADDED TO THE FIRST ELEMENT
	FMPR T,@(RA)		;SCALED BY AMPLITUDE
	MOVE T1,@1(RA)		;UPDATE SUM OF INCREMENTS
	FADM T1,3(RA)
	JRST 4(RA)

ZOSCL1:	MOVSI (-512.0)	;WRAP AROUND THE POINTER.
	JUMPGE INSXR,.+2
	MOVNS 0		;IF NEG. INC., WRAP AROUND OTHER WAY.
	FADB 0,3(RA)	;Update pointer
IFE KI10SW,<	MOVE INSXR,0
		KAFIX INSXR,233000	>
IFN KI10SW,<	KIFIX INSXR,0    	>  ;Fix it again and check range
	TRZN INSXR,777000	;Better be between 0 and 511
	  JRST (T1)
	JRST ZOSCL1		;Still out of range, try again

↑ZEXPEN: SKIPGE INSXR,3(RA)	;ZEXPEN WORKS LIKE ZOSCIL AND EXPEN!
	JRST [	WARN (Negative increment to ZEXPEN)
COMMENT ⊗ ZEXPEN is undefined for negative increments however if you contiune
it will treat it like a ZOSCIL.⊗;
		JSP T1,OSCIL1		;DO WRAPAROUND ANYWAY
		JRST .+1]		;LET THE LOSER CONTINUE
IFE KI10SW,<	KAFIX INSXR,233000	>
IFN KI10SW,<	KIFIX INSXR,INSXR	>  
	CAIL INSXR,777		;IF GREATER THAN 511, STICK
	JRST EXPEN2		;AT LAST ELEMENT (WE WON'T NEED TO INTERPOLATE)
	MOVE T,@2(RA)		;PICK UP FIRST ELEMENT
	move insxr		;SAVE INDEX
	move t1,t		;COPY FIRST ELEMENT
	addi insxr,1		;NO, INCREMENT INDEX
	fsbr t1,@2(ra)		;GET DWFFERENCE IN VALUE I
	fsc 233			;(FLOAT THE INDEX)
	fsb 3(ra)		;GET DIFFERENCE IN INDEX INTO 0
	fmpr t1,0		;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
	fadr t,t1		;IS ADDED TO THE FIRST ELEMENT
	FMPR T,@(RA)		;SCALED BY AMPLITUDE
	MOVE T1,@1(RA)		;UPDATE SUM OF INCREMENTS
	FADM T1,3(RA)
	JRST 4(RA)

COMMENT ⊗ ZINTRP
	JSP RA,ZINTRP
	<Value 1>		;-1(-6)
	<Value 2>		;0 (-5)
	<Temp - Increment>	;1 (-4)
	<array>(INSXR)		;2 (-3)
	<Temp - sum>		;3 (-2)
⊗;	
↑ZINTRP: ADDI RA,1		;AN INTERPOLATING INTRP!
IFE KI10SW,<
	MOVE INSXR,3(RA)
	KAFIX INSXR,233000	>
IFN KI10SW,<	KIFIX INSXR,3(RA)	>  
	TRZE INSXR,777000	;DID WE RUN OVER?
	JSP T1,ZOSCL1		;YES, DO WRAPAROUND (BUT IT REALLY SHOULDN'T!)
	MOVE T,@2(RA)		;PICK UP FIRST ELEMENT
	move insxr		;SAVE INDEX
	move t1,t		;COPY FIRST ELEMENT
	cain insxr,777		;ARE WE AT THE LAST ELEMENT
	tdza insxr,insxr	;YES, SET INDEX TO ZERO AND SKIP
	addi insxr,1		;NO, INCREMENT INDEX
	fsbr t1,@2(ra)		;GET DIFFERENCE IN VALUE I
	fsc 233			;(FLOAT THE INDEX)
	fsb 3(ra)		;GET DIFFERENCE IN INDEX INTO 0
	fmpr t1,0		;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
	fadr t,t1		;IS ADDED TO THE FIRST ELEMENT
	MOVE @(RA)		;GET SECOND VALUE
	FSBR @-1(RA)		;SUBTRACT THE FIRST
	FMPR T,0		;MULIPLY BY DIFFENCE BETWEEN TWO VALUES
	FADR T,@-1(RA)		;AND ADD TO THE FIRST VALUE
	MOVE T1,1(RA)		;UPDATE SUM OF INCREMENTS
	FADM T1,3(RA)
	JRST 4(RA)
;   More generators, LINEN

COMMENT ⊗ Called with:
	JSP RA,LINEN
	<Temp - Increment for attack>	;0 (-14)
	<Temp - Incrememt for middle>	;1 (-13)
	<Temp - Increment for decay>	;2 (-12)
	<Amplitude>			;3 (-11)
	<Attack time in seconds>	;4 (-10)
	<decay time in seconds>		;5  (-7)
	<Duration in seconds>		;6  (-6)
	<Array>(INSXR)			;7  (-5)
	<Sum of increments (not temp)>	;10 (-4)
	<Zeroed - Current increment >	;11 (-3)
	<Zeroed - End of section of array>;12(-2)
⊗;
↑LINEN:	MOVE INSXR,11(RA)	;GET INCREMENT.
;	FADB INSXR,10(RA)	;ADD TO POINTER.
	JUMPL INSXR,[ WARN (Negative increment to LINEN)
COMMENT ⊗ LINEN is undefined for negative increments.  The results may be
unpredicatable. Probably means that the attack time plus the decay time
exceeds the duration. ⊗;
		      JRST LINEN4-1]
	FADB INSXR,@10(RA)	;NOW YOU MUST RESET PTR
LINEN4:	CAML INSXR,12(RA)	;ARE WE PAST END OF SECTION ?
	JRST LINEN2		;YES.
IFE KI10SW,<	KAFIX INSXR,233000	>
IFN KI10SW,<	KIFIX INSXR,INSXR	>  
	MOVE T,@3(RA)		;AMPLITUDE.
	FMPR T,@7(RA)		;MULT. BY ARRAY ELEMENT.
	JRST 13(RA)	;RETURN.

LINEN2:	MOVE T,12(RA)	;PICK UP CURRENT LIMIT.
	FDVRI T,(<128.0>)
IFE KI10SW,<	KAFIX T,233000	>
IFN KI10SW,<	KIFIX T,T	>  
	CAIL T,3	;END OF ARRAY ?
	JRST LINEN3	;YES.
	HRLI T,RA	;PREPARE FOR INDEXING...
	MOVE @T		;PICK UP NEXT INCREMENT.
	MOVEM 11(RA)	;PUT AWAY.
	MOVSI (128.0)
	FADM 12(RA)	;INCREMENT LIMIT TO NEXT VALUE.
	JRST LINEN4
LINEN3:	MOVEI 14(RA)	;FAKE UP A PARAMETER FOR LINEN1.
	MOVEM .+2
	JSA RA,LINEN1	;RE-INITIALIZE THE GENERATOR.
	0		;
;	SETZM 10(RA)	;RESET PTR.
	SETZM @10(RA)	;NOW YOU MUST RESET PTR
	SETZM 11(RA)	;AND INCREMENT.
	SETZM 12(RA)	;...AND LIMIT.
	JRST LINEN

↑LINEN1: 0	;THE INITIALIZING CODE FOR LINEN.
	MOVE T2,(RA)	;GET POINTER TO END OF PARAMETERS.
	MOVE T1,[1.0] 	;CALC. 128*(SECONDS/SAMPLE)
	FDVR T1,SRATE
	FSC T1,7
	MOVE T,@-10(T2)	;GET RISE TIME IN SECONDS.
	FDVRM T1,T	;INCREMENT←T1/TIME (=128/(TIME IN SAMPS))
	MOVEM T,-14(T2)	;PLACE IN PARAMETER 0.
	MOVE T,@-6(T2)	;DURATION OF NOTE IN SECONDS...
	FSBR T,@-7(T2)	;...MINUS FALL TIME..
	FSBR T,@-10(T2)	;...MINUS RISE TIME.
	FDVRM T1,T	;CHANGE TO INCREMENT.
	MOVEM T,-13(T2)	;PLACE IN PARAMETER 1.
	FDVR T1,@-7(T2)	;INCREMENT FOR FALL TIME.
	MOVEM T1,-12(T2)	;PLACE IN PARAMETER 2.
	JRA RA,1(RA)

↑VALUE:	MOVE T,@(RA)	;DUMMY UNIT GENERATOR... OUTPUT IS
	JRST 1(RA)	;SAME AS ITS PARAMETER.
;   Reverberation Unit Generators

; REV1 IS THE SIMPLE FED-BACK DELAY LOOP, OR 'COMB FILTER'.

COMMENT ⊗ Called with:
	JSP RA,REV1
	<Input to reverberator>		;0 (-7)
	<Delay length>			;1 (-6)
	<Gain>				;2 (-5)
	<Array>(INSXR)			;3 (-4)
	<Temporary - Array pointer>	;4 (-3)
	<Temp. - Int. Length of array>	;5 (-2)
⊗;

↑REV1:	AOS INSXR,4(RA)		;INCREMENT OUTPUT PTR.
	CAML INSXR,5(RA)	;IS IT TIME TO WRAP AROUND ?
	SETZB INSXR,4(RA)	;YES.
	MOVE 1,@3(RA)		;GET OUTPUT OF DELAY LINE.
	MOVE 2,1		;LEAVE IN 1 AS FINAL OUTPUT.
	FMPR 2,@2(RA)		;MULTIPLY BY FEEDBACK GAIN.
IFE KI10SW,<
REVA:	MOVE @1(RA)		;GET DELAY TIME, T.
	KAFIX 0,233000	>
IFN KI10SW,<
REVA:	KIFIX 0,@1(RA)	>  
	ADD INSXR,0		;MOVE PTR. AROUND TO INPUT END.
	CAML INSXR,5(RA)	;PROBABLY HAVE TO WRAP AROUND..
	SUB INSXR,5(RA)		;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
	FADR 2,@(RA)		;ADD IN THE INPUT SAMPLE.
	JFCL 1,[SETZB 2,1	;FLOAT. UNDER FLOW
		SETOM FXUFLG#
		JRST .+1]
	MOVEM 2,@3(RA)		;PLACE IN INPUT OF DELAY LINE.
	JRST 6(RA)		;RETURN.

;REV2 IS THE ALL-PASS REVERBERATOR.

COMMENT ⊗ Called with:
	JSP RA,REV2
	<Input to reverberator>		;0 (-7)
	<Delay length>			;1 (-6)
	<Gain>				;2 (-5)
	<Array>(INSXR)			;3 (-4)
	<Temporary - Array pointer>	;4 (-3)
	<Temp. - Integer form of 1(RA)>	;5 (-2)
⊗;
↑REV2:	AOS INSXR,4(RA)	;CALC. PTR. AS IN REV1.
	CAML INSXR,5(RA)
	SETZB INSXR,4(RA)
repeat 0,<	; Comment out to make way for new reverberator
	MOVN 1,@3(RA)	;GET NEGATIVE OF OUTPUT OF DELAY.
	MOVN 0,@2(RA)	;ALSO NEGATIVE OF GAIN, G.
	FMPR 1,0	;FORM GAIN*OUTPUT
	MOVE 2,1	;(NOTE THIS IS POSITIVE).
	FMPR 1,0	;FORM -G↑2 * OUTPUT.
	FADR 1,@3(RA)	;(1-G↑2) * OUTPUT.
	FMPR 0,@(RA)	;FORM -G * INPUT.
	FADR 1,0	;FINAL OUTPUT IS -G*IN +(1-G↑2)*OUT.
>		; Ends repeat 0 above (JAM 10/28/75)
COMMENT ⊗	; KS 13-May-1977 substitute lattice form, eliminate a multiply!
	MOVN 1,@2(RA)	; PICK UP NEGATIVE OF GAIN, G.
	FMPR 1,@(RA)	; ACCUMULATE -G*INPUT
	MOVE 2,@3(RA)	; PICK UP OUTPUT OF DELAY
	FADRB 1,2	; TOTAL OUTPUT IS OUT-G*INPUT
	FMPR 2,@2(RA)	; FEED G*TOTAL OUTPUT BACK INTO DELAY
⊗		; KS -- End of JAM's substitution, start of mine
	MOVN 2,@(RA)	; PICK UP NEGATED INPUT
	FADR 2,@3(RA)	; ADD IN DELAYED SIGNAL
	FMPR 2,@2(RA)	; MULTIPLY IN GAIN
	MOVE 1,@3(RA)	; GET DELAYED SIGNAL AGAIN
	FADR 1,2	; COMBINE WITH ATTENUATED (INPUT+DELAYED SIGNAL)
; KS -- End of my substitution
	JRST REVA	;FROM HERE ON, SAME AS REV1.

;  THIS IS THE I-TIME CODE FOR DELAY, REV1 AND REV2.

↑REVI:	HRRZ T1,(RA)	;GET PTR. TO END OF REV PARAMS.
	MOVNI INSXR,1	;INSXR←-1
	HRRZ @-4(T1)	;GET -1ST ELEMENT OF ARRAY (THE LENGTH)
	MOVEM -2(T1)	;PLACE IN THE SECOND DUMMY PARAM.
IFE KI10SW,<
	MOVE T,@-6(T1)	;CHECK FOR ILL ARRAY REF.
	KAFIX T,233000	>
IFN KI10SW,<	KIFIX T,@-6(T1)	>  
	CAMGE 0,T
	JRST [	MOVNI INSXR,3	;INSXR←-3
		MOVE @-4(T1)
		PUSHJ P,ILLARF	;OOPS!
		JUMP T,@0
		JRST .+1 ]
	SKIPN REVINI	;SHOULD WE INIT. THE DELAY ARRAY ?
	JRST 1(RA)	;NO.
	SETZM -3(T1)	;YES. FIRST CLEAR THE POINTER LOC.
	HRRZ T,-4(T1)	;GET PTR. TO ARRAY.
↑REVI2:	ADDI -1(T)	; 0 NOW POINTS TO TOP OF ARRAY.
	HRL T,T
	SETZM (T)	;CLEAR FIRST ELEMENT OF ARRAY.
	ADDI T,1	;FORM BLT POINTER.
	BLT T,@0	;CLEAR REST OF ARRAY.
	JRST 1(RA)

; DELAY IS THE SIMPLE DELAY

COMMENT ⊗ Called with:
	JSP RA,DELAY
	<Input to reverberator>		;0 (-7)
	<Delay length>			;1 (-6)
	<Temporary - for compatability>	;2 (-5)
	<Array>(INSXR)			;3 (-4)
	<Temporary - Array pointer>	;4 (-3)
	<Temp. - Integer form of 1(RA)>	;5 (-2)
⊗;

↑DELAY:	AOS INSXR,4(RA)		;INCREMENT OUTPUT PTR.
	CAML INSXR,5(RA)	;IS IT TIME TO WRAP AROUND ?
	SETZB INSXR,4(RA)	;YES.
	MOVE 1,@3(RA)		;GET OUTPUT OF DELAY LINE.
IFE KI10SW,<
	MOVE 0,@1(RA)		;GET DELAY TIME, T.
	KAFIX 0,233000	>
IFN KI10SW,<	KIFIX 0,@1(RA)	>  
	ADD INSXR,0		;MOVE PTR. AROUND TO INPUT END.
	CAML INSXR,5(RA)	;PROBABLY HAVE TO WRAP AROUND..
	SUB INSXR,5(RA)		;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
	MOVE 2,@(RA)		;GET INPUT SAMPLE.
	MOVEM 2,@3(RA)		;PLACE IN INPUT OF DELAY LINE.
	JRST 6(RA)		;RETURN.
SUBTTL    Random Numbers
;;  RANDOM NUMBER GENERATORS.

COMMENT ⊗
CALLED WITH:
	JSP RA,RANDH
	<Scale factor>		;0 (-5)
	<Increment>		;1 (-4)
	<Temp - Sum>		;2 (-3)	 Gets new random number
	<Temp - Random number>	;3 (-2)  upon wraparound
⊗;
↑RANDH:	MOVE @1(RA)	;GET INCREMENT.
	FADB 2(RA)	;INCREMENT THE 'POINTER'.
	CAML [512.0]	;OVER 512 ?
	JRST RNDH2	;YES. GO GET NEW RANDOM NUMBER.
	MOVE T,@(RA)	;NO. GET INPUT ...
	FMPR T,3(RA)	;... AND MULT. BY CURRENT RANDOM NO.
	JRST 4(RA)	;RETURN.
RNDH2:	MOVSI (-512.0)	;CAUSE 'POINTER' TO 'WRAP AROUND'.
	FADM 2(RA)
	PUSHJ P,RAND	;GET NEW RANDOM NO.
	MOVEM T,3(RA)	;MAKE IT THE CURRENT NO.
	FMPR T,@(RA)	;MULT. BY INPUT.
	JRST 4(RA)	;RETURN.

↑IRANDI:		;I-TIME CODE FOR RANDI AND RANDH.
↑IRANDH: PUSHJ P,RAND	;INIT. RANDH.
	MOVE T2,(RA)	;GET PTR. TO LAST PARAM..
	MOVEM T,-2(T2)	;PUT INITIAL RAND. NO. IN.
	JRST 1(RA)

↑RANDI:	MOVE T,2(RA)	;GET CURRENT DELTA..
	FADRB T,4(RA)	;ADD TO LAST OUTPUT VALUE...
	SOSG 3(RA)	;DECREMENT STEP COUNTER ...
	JRST RNDI2	;IT'S 0, SO GET NEW RANDOM NO.
	FMPR T,@(RA)	;NO.  MULT BY INPUT.
	JRST 5(RA)	;RETURN.
RNDI2:	PUSHJ P,RAND	;GET NEXT RANDOM NO.
	FSBR T,4(RA)	;FORM DELTA (=NEW  - OLD)
	MOVSI T1,(512.0)
	FDVR T1,@1(RA)	;NO. OF STEPS = 512/(FREQ. INPUT)
	FDVR T,T1	;CHANGE PER STEP =DELTA/NO. OF STEPS
	MOVEM T,2(RA)	;STORE CHANGE PER STEP.
IFE KI10SW,<	KAFIX T1,233000	>
IFN KI10SW,<	KIFIX T1,T1	>  
	MOVEM T1,3(RA)	;PUT IT AWAY.
	JRST RANDI	;NOW GO GENERATE FIRST STEP.

	BEND U.G.

IFN 0,<	; JAM 11/12/75 - MAKE THIS THING HONEST!!!
RAND:	MOVE T,RNDNO1	;GENERATE A RANDOM NO.
	ADD T,RNDNO2	;How dare you call this a random number
	EXCH T,RNDNO2	;generator!!!
	MOVEM T,RNDNO1
	ASH T,-10	;SMEAR  SIGN INTO EXPONENT FIELD..
	FSC T,200	;... AND FLOAT IT IN RANGE -1 TO 1.
	POPJ P,
RNDNO1:	 756132257563
RNDNO2: 756132257565
>; IFN 0,JAM 11/12/75 - MATCHES IFN 0 ABOVE

; LINEAR CONGRUENTIAL RANDOM NUMBER GENERATOR

RAND:	SKIPE T,SEED	; PICK UP LAST NUMBER
	JRST RAND1	; ALREADY INITIALIZED
	RUNTIM T,	; NEED NEW SEED, GET IT FROM DATE AND TIME
	ROT T,=12	; SCRAMBLE THESE NUMBERS GOOD
	MSTIME T1,
	XOR T,T1
	ROT T,=12	; INVERT THE SIGNIFICANCE OF THE BITS
	DATE T1,
	XOR T,T1
RAND1:	IMUL T,[267455123765]
	MOVS T,T
	MOVEM T,SEED
	ASH T,-10	;SMEAR  SIGN INTO EXPONENT FIELD..
	FSC T,200	;... AND FLOAT IT IN RANGE -1 TO 1.
	POPJ P,

SEED:	0		; LAST RANDOM NUMBER GENERATED
SUBTTL FORTRASH Routines and Random Functions

INTERNAL RDNUM,PNUM,SBFILN,SBDEVN,ARRLEN
;INTERNAL RDNUM,MESS,PNUM,QTTYIN,SBFILN,SBDEVN
INTERNAL INFIL2,INFIL3,INFIL4,INFILE
;SBFILN=FILE NAME FOR PLAY PROG.  SBDEVN=DEVICE NAME
EXTERNAL JOBDDT;

FOOPRT: 0
	JRST PNUM2
PNUM:	0
;	MOVE P,JOBFF	;$%%##$$##
	MOVE P,[IOWD LOSTK,OSTK]	;THAT'S BETTER!
PNUM2:	JSR SAVE
	MOVE A,@(RA)
	PUSHJ P,OUTFLT
	JSR RESTORE
	JRA RA,1(RA)

RDNUM:	0	;NUMBER READER FOR FOOTRAN ROUTINES.
;	MOVE P,JOBFF	;GET TEMP. PDL	*****
	MOVEM P,RDNUMP#
	MOVE P,[IOWD LOSTK,OSTK]	;THAT'S BETTER!
	EXCH FL,FLSV1
RDNUM1:	TLO FL,SNUMF1+NOSTAR	;INHIBIT PROMPT!
	PUSHJ P,SCAN
	CAMN A,MINV	;A MINUS SIGN ?
	TLOA FL,MINFLG	;YES. SET FLAG AND LOOP BACK.
	TLNN A,NUMFLG	;IT IS A NUMBER, ISN'T IT ?
	JRST RDNUM1	;NO. IGNORE IT.
	TLZE FL,MINFLG	;YES. HAVE WE SEEN A MINUS LATELY ?
	MOVNS C		;YES.
	MOVEM C,@(RA)	;PUT VALUE INTO PARAMETER.
	TLZ FL,NOSTAR
	EXCH FL,FLSV1
	MOVE P,RDNUMP
	JRA RA,1(RA)	;RETURN TO (UGH ! BLETCH !) FOOTRAN.

INT:	0		;INTEGER PART
	;Cretinous KI10 does a FORTRAN FIX, not the Entier function!
	;So, we get to do the floor function the hard way!
IFE KI10SW,<	MOVE 0,@(RA)
		KAFIX 0,233000	>
IFN KI10SW,<	KIFIX 0,@(RA)  >;Use KI10 fix instruction in to do hard stuff
	FSC 0,233
	SKIPGE @(RA)		;Argument negative?
	    CAMN 0,@(RA)	;    And was not already an integer
	  JRA RA,1(RA)		;  No, return FIX(X)
	FSBRI 0,(<1.0>)		;Yes, then KIFIX is off by one for
	JRA RA,1(RA)		;Entier function

;	STRLEN
ARRLEN:	0		;Returns length of array
	HRRZ 1,(RA)
	MOVE 1,-1(1)
	FSC 1,233
	JRA RA,1(RA)	;RETURNS LENGTH IN AC1
STRLEN:	0		;Returns length of string
	MOVEM 2,SAVE2#
	HRRZ 2,(RA)
	HRLI 2,440700
	SETZ 1,
	ILDB 0,2
	JUMPE 0,[ MOVE 2,SAVE2#
		  FSC 1,233
		  JRA RA,1(RA) ]
	AOJA 1,.-2

;ARRBLT(TO,FROM,COUNT)
ARRBLT:0
	HRRZ 0,(RA)
	HRL 0,1(RA)
	HRRE 1,@2(RA)
	ADD 1,(RA)
	BLT 0,-1(1)
	JRA RA,3(RA)
SUBTTL Extended Commands
;(PRECEDED BY <ALT MODE> OR ⊗)
COMMND:
	SETO 1,
	TTYUUO 6,1
	TLNN 1,420000		;SKIP IF NOT AT DD OR III
	OUTSTR [ASCII /$/]
	PUSHJ P,SCANNS	;GET COMMAND.
	CAMN A,EXITV		;AN EXIT?
	EXIT
	CAME A,LISTV
	TLNE A,DECLBIT
	JRST CMDLST	;A LIST STATEMENT
	JUMPL A,[COMND1: OUTSTR [ASCIZ /UNKNOWN COMMAND?? /]
		 JRST SCHOWN]
	MOVE ACCUM
	MOVE 1,ACCUM+1
	LSHC 6
	SETZ B,
COMND2:	SKIPN CMDTAB(B)
	JRST COMND1
	CAME CMDTAB(B)
	AOJA B,COMND2
	JRST @CMDTA2(B)
CMDTAB:			;TABLE OF EXTENDED COMMANDS
	SIXBIT/EXCISE/
	SIXBIT/FREEZE/
	SIXBIT/P/
	0
CMDTA2:
	EXCISE
	FREEZ1
	CPLAY
	
CPLAY:	SKIPN MTA  ;******DON'T PLAY, USING MAGTAPE*************
	PUSHJ P,PLAY↑
	JRST SCHOWN
;   More Command Routines.
EXCISE:
	MOVE JOBFF
	CORE
	SYSERR<Can't reduce core!>
COMMENT ⊗ Shouldn't happen. ⊗;
	MOVE JOBREL
	MOVEM BEGFRE	;UPDATE FREE STORAGE POINTER
	JRST SCHOWN
FREEZ1:
	SETOM ONCEFG	;TURN ON HELP MESSAGE, ETC.
	MOVE A,[XWD BUCTBL,SVAREA]
	BLT A,2*SVAREA-BUCTBL-1	;SAVE SYMBOL TABLE POINTERS
	MOVE JOBFF	;SAVE JOBFF
	MOVEM OLDJFF
	CORE
	SYSERR <Can't reduce core!>
COMMENT ⊗ Shouldn't happen. ⊗;
	OUTSTR [ASCIZ/FROZEN!/]
	EXIT 1,
	JRST GO

;   This handy routine tells you what's in the symbol table

;THE COMMAND FORM
CMDLST:	PUSH P,[[PUSHJ P,SCAN	;EAT THE OPTIONAL 'LIST'
		CAME A,LISTV	
		JRST CHOWN
		JRST SCHOWN]]

LSTSYM:	MOVE B,[XWD -(LSTEND-LSTTAB)-1,LSTTAB-1]
	AOBJP B,CPOPJ	;SEARCH FOR TYPE DECLARATION FAILED
	CAME A,@(B)	;THIS TYPE?
	JRST .-2	;NO, TRY NEXT
	HLRZ C,(B)	;GET RANDOM GOOD BIT
	MOVE D,[XWD -BUCKNO-1,BUCTBL-1]	;SEARCH EACH BUCKET
	AOBJP D,CPOPJ	;LAST ONE?
	MOVE B,(D)	;GET BEGINNING OF BUCKET
LSTLOOP:CAIN B,A-1	;AT END?
	JRST .-3	;YES
	MOVE A,2(B)	;FOR PRNTSYM
	TLNE A,(C)	;RIGHT RANDOM GOOD BIT ON?
	JRST [	MOVEI A,2(B)	;FOR PRNTSYM
		PUSHJ P,PRNTSYM	;YES, PRINT SYMBOL NAME
		OUTSTR[ASCIZ/	/]
	JRST LSTLO1]
LSTLO1:	MOVE B,(B)	;GET NEXT ONE ON LIST
	JRST LSTLOOP

LSTTAB:	XWD VRBLBT,VARV
	XWD ARRYBT,ARRV
	XWD INSBIT,INSV
	XWD FUNBIT,FUNV
	XWD UGBIT,UGV
	XWD 777740,LISTV
LSTEND←←.

;ROUTINE CALLABLE FROM DDT
LISTSY:	JSR SAVE	;SAVE AC'S
	EXCH H,SNCHR	;SAVE SNCHR
	OUTSTR[ASCIZ/
FOR:/]
	PUSHJ P,SCANNS
	PUSHJ P,LSTSYM
	EXCH H,SNCHR	;RESTORE SNCHR
	JSR RESTORE
	POPJ P,
SUBTTL SMPOUT - Sample Output Buffer Routines
;THIS IS THE NEW MAGIC SAMPLE BUFFER ROUTINES, WATCH THEM HANDLE
;THE DISK, THE UDP AND THE DAC, ALL IN ONE PROGRAM!!!

BEGIN SMPOUT

DBLKSZ←←200	;SIZE OF A DISK BLOCK
DBFNUM←←=10	;NUMBER OF BUFFERS (SHOULD BE SOME FACTOR OF 18, PLUS 2)
		;BUFFERING
SBDNUM←←=11*=18	;NUMBER OF BLOCKS IN A SAMPLE FILE (SHOULD BE MULTIPLE
		;THE RECORDS/TRACK FOR DISK
SBUNUM←←10	;NUMBER OF BLOCKS BETWEEN SAVES (MUST BE POWER OF 2)

TODSK←←2

DEVIOS←←2	;OFFSET TO I/O STATUS WORD IN DDB
IOSYNC←←40	;ONE BUFFER AT A TIME, PLEASE (SYMBOL: 'IOSYNC` INVENTED)

↑PLINIT:SETZM BLKNUM	;CLEAR BLOCK COUNT
	SETZM SAVDON	;CLEAR .SAV WRITTEN FLAG
	SETZM QUIET#	;SUPPRESS STATS AND FILE INC.
	SETZM SBWC	;CLEAR WORD COUNT
	SETZM RUFLAG	;CLEAR 'RUN .SAV` FLAG
	MOVEI A,1
	MOVEM A,SBUSET	;Reset USETO pointer
	OUTPUT TTY,	;FLUSH THE TTY BUFFER, WE'RE TTYUUOING AROUND
			;HERE
	LDB A,SCP	;Check for PLAY <file spec>
	CAIN A," "

	JRST [	MOVE A,[PUSHJ P,SCNGET]
		JRST PNOASK ]
	MOVSI A,(<POINT 7,0>)	;Make string pointer to default output
	HRR A,OUTFIL		;specification.
	MOVEM A,SPCPTR#
	MOVE A,[ILDB 1,SPCPTR]
	SKIPN @OUTFIL		;Make sure there is something there
PLOOP1:	MOVE A,[INCHWL 1]	;CHARACTER STREAM
PNOASK:	MOVEM A,PLAYOP#
	SETZM BYTSIZ
	CAMN A,[INCHWL 1]
	OUTSTR [ASCIZ/
Output: /]
	PUSH P,[SBDEVC+1]
	PUSH P,PLAYOP
	PUSH P,[0]
	PUSHJ P,RDIOSP
	JFCL
	PUSHJ P,IGNOLF
	SETZ A,
	SKIPN SBFILN+1		;DOES FILE HAVE AN EXTENSION
	JRST [	SKIPN SBFILN	;NO, A FILE NAME?
		JRST INIDSK	; GO INIT DSK
		TYPSTR [ASCIZ/Please include an extension or ':'
/]
		JRST PLINIT]
	SKIPN SBFILN
	JRST [	TYPSTR [ASCIZ/You need a file name.
/]
		JRST PLOOP1]
	JRST INIDSK		;***** NEW OCT 9,77
PLINI2:	MOVEM F,PLYOPT	;SAVE PLAY OPTION NUMBER
	MOVE SIZ,SSIZES(F)	;GET BUFFER SIZE
;;;	MOVEM SIZ,LSBUF#;SAVE BUFFER SIZE
PLINLO:	MOVE T,BEGFREE	; FIGURE OUT HOW MUCH SPACE WE HAVE
	SUB T,JOBFF
	SUBI T,4*LOBUFS
	CAMGE T,SIZ
	COREFULL	;GET SOME CORE WHILE WE CAN
	JRST PLINLO	;TRY AGAIN

	MOVN T,SIZ
	PUSHJ P,GFS	;CALL FREE STORAGE ROUTINE
	MOVE THIS,T
	MOVEM THIS,SBBOTT;SAVE ADDRESS OF BUFFER
REINIT:	MOVE THIS,SBBOTT
	HLL THIS,SBPTRS(F)	;GET APPROPRIATE BYTE POINTER
	MOVEM THIS,SBPTR	;SET UP BYTE POINTER FOR SAMPLES
IFE KI10SW,<	MOVE 0,BITS 
		KAFIX 0,233000	>
IFN KI10SW,<	KIFIX 0,BITS   >;  BITS SETS THE BYTESIZE ********
	MOVEM BYTSIZ#
    	MOVE SAVCNT	;HAS IT BEEN FIXED YET?
    	TLNE -1		;IS IT FLOATING ?
IFE KI10SW,<	KAFIX 0,233000	>
IFN KI10SW,<	KIFIX 0,0   >
    	MOVEM SAVCNT   ;  SAVCNT SETS THE SAVE RECORD NUM.****
;;	KIFIX SAVIT	
;;	MOVEM SAVCNT 
	SKIPE SIZ,BYTSIZ	;NON-STANDARD BYTE SIZE?
	DPB SIZ,[POINT 6,SBPTR,11]
	LDB SIZ,[POINT 6,SBPTR,11]
	MOVEI THIS,=36
	IDIV THIS,SIZ
	MOVEM THIS,NBYTES
	IMUL THIS,SSIZES(F)
;;;	IMUL THIS,LSBUF
	MOVEM THIS,SBCNT
	POPJ P,

↑ANSWER:INCHWL
	CAIN 12		;IN CASE THERE WAS A <LF> IN THE TTY BUFFER
	JRST ANSWER
	CAIE "y"	;EAT LOWER CASE, TOO
	CAIN "Y"	;IF "Y" THEN SKIP
	AOS (P)
	CAIN 12		;END OF LINE?
	POPJ P,		;YES
	INCHWL		;NO, GET ANOTHER AND TRY AGAIN
	JRST .-3
;EXTERNAL JOBJDA

MAKBUF:	MOVE SBBOTT	;GET ADDRESS OF BUFFER
	PUSH P,SBPTR
	EXCH JOBFF
	OUTBUF SBCHAN,@BUFNUM(F)
	EXCH JOBFF
	POP P,0
	TLZ 0,770000
	HLLM 0,SBPTR
	POPJ P,		;NOW, RETURN
	ERROR <ERROR IN SETTING UP BUFFER RINGS>

;   Initialize DSK or UDP for output;

INIDSK:	SKIPN SBFILN
	JRST [	OUTSTR [ASCIZ/Illegal file name
/]
		JRST PLINIT]
	SETZ B,
;INIDS3:
INIDS4:	SETZM SBDEVC		;SET BUFFERED MODE
	SETZM TIME					
	MOVSI SBHDR
	MOVEM SBDEVC+2
	OPEN SBCHAN,SBDEVC
 	SYSERR<Can't INIT DEVICE!>  ;An unlikely situation. ⊗;
;**********************MAGTAPE****************************
;** TO USE TAPE - OUTFILE←"MTA0:X.X"; ONLY MTA0 OR MTA1  *
	SETZM MTA      ;MAGTAPE FLAG			;*
  	MOVE 1,SBDEVN       ;IS THE DEVICE MTA0?	 *
	CAMN 1,[556441,,200000] ; = MTA0		 *
	JRST .+3					;*
	CAME 1,[556441,,210000] ; = MTA1		 *
	JRST INIDS5					;*
	SETOM MTA	  ;YES, SET THE FLAG		;*
	SETZM MAXSMP	;SO HEADER WON'T LIE ABOUT IT	;*
	SKIPN SAVCNT	;CAN'T DO 'SAVES' WITH MTA0	 *
;;	SKIPN SAVIT	;CAN'T DO 'SAVES' WITH MTA0	 *
	JRST .+3					;*
	OUTSTR [ASCIZ/CAN'T DO 'SAVES' WHEN USING MTA.      
/]							;*
;;	SETZM SAVIT					;*
  	SETZM SAVCNT					;*
	MOVE 1,MTADUR		;HAS DURATION BEEN SET?  *
	JUMPE 1,INIDS6		;NO			 *
	FMPR 1,SRATE		;TO GET NUM. OF SAMPLS   *
IFE KI10SW,<	KAFIX 1,233000	>			;*
IFN KI10SW,<	KIFIX 1,1   >				;*
	MOVEM 1,TIME		;TIME=SMPL TOTAL, FIXED  *
	SETZM MTADUR		;RESET IT TO 0		 *
	JRST INIDS5 					;*
INIDS6: OUTSTR [ASCIZ/ HEADER WILL NOT INCLUDE DURATION.
/]							;*
;**********************MAGTAPE****************************
INIDS5:	MOVEI F,TODSK	;DSK IS OPTION 2
 	PUSHJ P,PLINI2	;CALL THE BUFFER ALLOCATION
	PUSHJ P,MAKBUF
   	PUSHJ P,ENTFIL
;   Sound file headers

;As of 29 March 1977, a sound file header looks like...
; WD 0 - 525252525252
; WD 1 - Clock rate
;	has code in LH, actual rate in RH
;	code=0 for 6.4Kc (or anything else)
;	    =1 for 12.8Kc, =2 for 25.6Kc, =3 for 51.2Kc
;	    =5 for 102.4Kc, =6 for 204.8Kc
; WD 2 - pack
;	0 for 12 bit
;	1 for 16 bit (18 bit)
;	2 for 9 bit floating point incremental
;	3 for 36-bit floating point
;	N>9 for N bit bytes in ILDB format
;	has # samples per word in LH.
; WD 3 - # channels
;	1 for MONO
;	2 for STEREO
;	4 for QUAD
; WD 4 - Maximum amplitude (if known)
;	is a floating point number
;	is zero if not known
;	is maximum magnitude (abs value) of signal
; WD 5 - is exact number of samples.
; WDs 6-77 Reserved for future expansion
; WDs 100-177 Text description of file (in ASCIZ format)
;
↑WRTHDR:
	PUSH	P,C		; [IRC] GET AN AC.
	MOVE	C,SBHDR		; [IRC] GET BUFFER ADDRESS
	ADDI	C,2		; [IRC] WELL, ALMOST
	HRLZI	B,(C)		; SET UP A BLT POINTER
	HRRI	B,1(C)
	SETZM	(C)		;****** [IRC] CLEAR OUT HEADER
	BLT	B,177(C)
	MOVE T,[525252525252]
	MOVEM	T,0(C)		; [IRC] STICK IN HEADER 
	FIXR T,SRATE		;Take and round the sampling rate
;Check for known speed
	MOVEI A,NHDRSP-1	;Search speed table
HDLP1:	CAME T,HDRSPT(A)
	  SOJG A,HDLP1
	HRL T,A			;Put actual speed in left half
	MOVEM	T,1(C)		; [IRC]
;Check for special packing modes
IFE KI10SW,<	MOVE T,BITS
		KAFIX T,233000	>
IFN KI10SW,<	KIFIX T,BITS  >
	SETZ B,
	CAIE T,=12
	AOJ B,
	MOVEI A,3
	SUB A,B		;PUT NUM SMPLS/WD IN LFT. HALF (3 OR 2 ONLY.)
	HRL B,A
	MOVEM B,2(C)		;PUTS 0 FOR 12, 1 FOR 18 BIT PACKING ONLY.
IFE KI10SW,<	MOVE T,NCHNS
		KAFIX T,233000	>
IFN KI10SW,<	KIFIX T,NCHNS >  ;Output number of channels
	MOVEM	T,3(C)		; [IRC]
	IMUL T,TIME		;NCHNS*TIME=TOTAL SMPLS
	MOVEM  T,5(C)		;Gives total sample count. (6TH WD)
	FLTR T,MAXSMP	;Put out max. sample we know about(flting pt.)
	MOVEM	T,4(C)		; [IRC]  (5TH WD)

	SKIPE MTA	;*********** MAGTAPE ?? ***********
	JRST MTAHDR	;******* YES *******
  	HRLZI	A,-200		; [IRC] MAKE UP A IOWD
  	HRRI	A,-1(C)
  	GETSTS	SBCHAN,B	; [IRC] GET OUR STATUS
  	PUSH	P,B		; SAVE IT
  	SETZ	B,
  	SETSTS	SBCHAN,17	; [IRC] CHANGE TO DUMP MODE
  	OUTPUT	SBCHAN,A	; [IRC]
	POP	P,B		; [IRC] GET BACK OLD STATUS
	SETSTS	SBCHAN,(B)
	JRST HDRSPT-2
MTAHDR:	MOVE A,SBPTR	;******** MAGTAPE *******
	ADDI A,200	; CAN'T USE 'SAVCNT'    *
	MOVEM A,SBPTR	;BECAUSE BUFFERS MIXUP ;*
	OUT SBCHAN,    ;********** MAGTAPE ******

	POP	P,C		; [IRC]
	POPJ P,			;Next output will put out header
;Header speed table
HDRSPT:	=6400
	=12800
	=25600
	=51200
	=102400
NHDRSP==.-HDRSPT
;   Routines to Make File Names, and Keep the System Happy

BUFOUT:	AOS SBUSET	;Update USETO pointer
	OUT SBCHAN,
	POPJ P,
	WARN <Output error?>
COMMENT ⊗ Error detected while writing out sample buffer ⊗;
	POPJ P,

FINFIL:	JFCL         	;BUFFERED I/O?
	PUSHJ P,BUFOUT	;YES
	CLOSE SBCHAN,	;WRITE END OF FILE
	MOVE A,BLKNUM
	JSA RA,SAVER	;SAVE A DUMP FILE
	SKIPN QUIET
	PUSHJ P,STATS	;PRINT STATISTICS
	SKIPN QUIET
	TYPSTR [ASCIZ/	/]
	PUSH P,SBHDR	;SAVE HEADER FOR BUFFER RING (OPEN CLOBBERS THESE!)
	PUSH P,SBPTR	;SAVE BYTE POINTER
	OPEN SBCHAN,SBDEVC
	ERROR <Can't re-INIT output device.>
COMMENT ⊗ Someone else it probably using it. ⊗;
	POP P,SBPTR	;RESTORE BYTE POINTER
	POP P,SBHDR
	MOVE A,SBHDR	;Go thru buffer ring clearing use bits
	PUSH P,B	;Save a register
	MOVSI B,400000
CLRRNG:	ANDCAM B,(A)	;Clear use bit
	HRR A,(A)	;Pickup next buffer
	CAME A,SBHDR	;Done yet?
	  JRST CLRRNG
	POP P,B		;Restore register
	AOS BLKNUM
	HLLZ 1,SBFILN+1		;INCREMENT EXTENSION
	MOVE SBFILN+3
	MOVEM SAVPPN#		;SAVE THE PPN
	  JRST[	SETZM SBFILN+3   ;;;MOVE 0,SBFILN+3	;Save PPN over LOOKUP
	RSBLOK:	LOOKUP SBCHAN,SBFILN	;LOOKUP file to extend it
		  JRST[	ERROR <Can't find file just written to extend it>
COMMENT ⊗ The music program saves its computation in a way that could be
continued from.  Part of this involves closing the output file and then
opening again to extend it.  However, upon trying to open it, the file
could not be found!!  Run your .SAV file after figuring out where the
file disappeared to ⊗;
			JRST RSBLOK]
	RSBENT:	SETZM SBFILN+3
		ENTER SBCHAN,SBFILN
		  JRST[	WARN <Someone is reading the sound file you are trying to write>
			JRST RSBENT]
		USETO SBCHAN,@SBUSET	;Move to remembered end of file.
		MOVE SAVPPN
		MOVEM SBFILN+3		;GET BACK PROPER PPN
		JRST FINFI2]		;Finish setting up for more output.
ENTFIL:	SETZM SBFILN+3
	ENTER SBCHAN,SBFILN	;ENTER THE FILE NAME
	ERROR <Can't OPEN output file>
COMMENT ⊗ Usually this means the file is protected or already being
written. ⊗;
FINFI2:
	MOVEI A,SBCHAN		;Display progress of output file with WHO line
	SHOWIT A,
	OUT SBCHAN,
	JRST .+2
	ERROR <Can't setup buffers for output>
COMMENT ⊗ This error is probably due to some change to I/O in system. ⊗;
	SKIPG A,SAVCNT		;Skip if save count specified
	MOVE A,SBBLKS(F)	;SET NUMBER OF 128 WORD BLOCKS PER FILE
	MOVEM A,SBBCNT
	SETZM SBWC
	POPJ P,
;   Sample Output Routines For Each Device

DSKOUT:
	SKIPE SAVCNT	;Ignore NOMAX if saving
	SOSLE SBBCNT	;DON'T SAVE EVERY TIME THRU
	  JRST BUFOUT	;  Output buffer and return
	PUSHJ P,FINFIL	;Write out file and re-open to extend
	POPJ P,		;Return

DSKFIN:	PUSHJ P,FILLBF	;FILL REMAINDER OF BUFFER WITH 4000'S
			;AND PRINT WORD COUNT, ETC.
	CLOSE SBCHAN,	;SAVE, SET UP FILES, ETC.
DSKFI2:	MOVE THIS,SBBOTT	;GET LOWER OF TWO OUTPUT 
			;DECREMENT TO POINT TO BEGINNING OF 
			;FREE STORAGE BLOCK TO BE RELEASED

	RELEAS SBCHAN,;Finished Doing Output, Close and Release Space
	MOVE SSIZES(F)
	ADDM BEGFREE
	POPJ P,		;RETURN

FILLBF:
	USETO SBCHAN,1	;Back to beginning of file
	OUT SBCHAN,	;Setup buffers for WRTHDR
	SKIPN MTA	;************************************
	PUSHJ P,WRTHDR	;Write out header
STATS:	TYPSTR [ASCIZ/
/]
   	JRST [	PUSH P,[SBFILN]
   		PUSHJ P,PRTFLN
 		JRST STATS1]
STATS1:	TYPSTR [ASCIZ/   Time = /]
	MOVE A,TIME
	CAME H,[XWD 200000,0]
	SUB A,H
	FSC A,233
	FDVR A,SRATE
	PUSHJ P,OUTFLT	;PRINT REAL TIME
       	TYPSTR [ASCIZ/   Max. sample = /]
	MOVE A,MAXSMP	;PRINT MAXIMUM SAMPLE
	PUSHJ P,DECPNT
	POPJ P,
SUBTTL Sample Buffer Tables, etc.

SBPTRS:	POINT 12,0	;BYTE POINTER
	POINT 18,0
	POINT 18,0
	POINT 18,0

BYTWRD:	3	;BYTES/WORD
	2
	2
	2

SSIZES:	0	;OPTIMAL BUFFER SIZE
	0
	DBFNUM*(DBLKSZ+3)+1	;EXTRA WORD TO PREVENT EXTRA K OF
	3*(DBLKSZ+3)+1		;CORE TO BE ALLOCATED

SBBLKS:	0
	SBDNUM
	SBDNUM

BUFNUM:	0	;(ENTRY NOT USED);TABLE OF RECORD SIZES
	0	;(ENTRY NOT USED)
	DBFNUM	;DISK RECORD SIZE

↑OUTTAB:0     	;TABLE OF OUTPUT ROUTINES
	0
	DSKOUT

↑FINTAB:0     	;TABLE OF ROUTINES TO CALL AT END
	0
	DSKFIN

↑PLYOPT:0	;USED TO DETERMINE WHICH ROUTINE TO CALL TO
		;DO OUTPUT, ETC.
SBBCNT:	0	;IF OUTPUT IS TO DISK, THE NUMBER OF BLOCKS
		;REMAINING TO BE WRITTTEN ON THIS FILE
↑MTSYSA:[-1]	;ADDRESS OF WORD USED TO DETECT 'INTERRUPT' TO COMPUTATION
		;OF SAMPLE

↑SBDEVC: 0	;MODE
↑SBDEVN: 0	;DEVICE NAME
	 0	;POINTER TO BUFFER HEADER
↑SBFILN:BLOCK 4	;FILE NAME

↑SBHDR:	0	;BUFFER HEADER
↑SBPTR:	0	;BYTE POINTER
↑SBCNT:	0	;NUMBER OF BYTES LEFT IN BUFFER
SBWC:	0
↑NBYTES: 0	;NUMBER OF BYTES/WORD
SBUSET:	1	;USETO pointer
;;↑SAVCNT:	0	;Flag and/or inverval (in buffers) between saves

↑SBIOWD:0	;IOWD FOR SAMPLE BUFFER
↑BLKNUM:0	;NUMBER OF THE BLOCK (FILE) BEING WRITTEN ON
		;THE UDP(DISK)
SBBOTT:	0	;POINTER TO BEGINNING OF BUFFER BEING FILLED

↑PZEROS:BLOCK 4
	BEND SMPOUT
SUBTTL SAVER
BEGIN  SAVER
;		       (INSERTED 11/3/69)
;	       TO DUMP CORE IMAGE
;       CREATE A FILE OF THE CURRENT CORE IMAGE.
;       PICK UP THE USER'S INPUT FILE NAME STORED
;       IN DLK AND CREATE A FILE CALLED:
;	   "NAME.SAV"
;       WHERE NAME IS THE INPUT FILE NAME.
;
;       THE SWAP UU0 WILL BE USED WHICH CLOSES ALL 
;       ACTIVE DEVICES.  

INTERNAL SAVER

↑SAVER:       0
	MOVEM   17,ACS+17   ;SAVE REGISTERS
	MOVEI   17,ACS
	BLT     17,ACS+16
	MOVE    0,SCP       ;BASE OF INPUT BUFFER
	HRRZ    T,IBUF      ;CURRENT BUFFER
	SUBI    0,-BUF1-1(T) ;DIFFERENCE
	MOVEM 0,PLIST+LPLIST-10

	SKIPN T,DLK		;INPUT FILE NAME
	MOVSI T,'SAV'		;DEFAULT FILE NAME
	MOVEM T,SWPTBL+1
	MOVE T,JOBREL	;GET LENGTH OF CORE IMAGE (SYSTEM THINKS
			;THAT PART OF THE CORE IMAGE IS BUFFERS
			;AND DOES NOT SAVE ALL OF IT.)
	AOJ T,		;ADD 1 TO GET CORE SIZE
	ASH T,-=10	;DIVIDE BY 1024
	HRLM T,SWPTBL+3	;SET SAVE SIZE IN 1K BLOCKS

	SETOM SAVDON	;INDICATE SAVE WAS DONE
	MOVSI T,SWPTBL	;ADDR OF 5 WORD BLOCK IN LEFT PART OF T
	SWAP T,
	SETZM RUFLAG	;CLEAR FLAG INDICATING RESTART
	JRST RETR+1

RETR:	SETOM RUFLAG 	;SET FLAG INDICATING RESTART
	MOVE   P,[XWD -10,PLIST+LPLIST-10]     ;PICK UP ACCUM P
	MOVEI   FL,RESTART  ;RESTORE RESTART FLAG
	SOS RECCT		;BACK UP TO PREVIOUS INPUT RECORD.
	PUSHJ   P,SETUP     ;JUMP TO RESTORE FILES
	POP P,SCP
	MOVEI GO	;FIX UP STARTING ADDRESS
	HRRM JOBSA
	MOVE [SIXBIT/MUSIC/]
	SETNAM
	MOVSI   17,ACS      ;RESTORE REGISTERS
	BLT     17,17
	JRA 16,(16)

↑RUFLAG: 0		;FLAG INDICATING PROGRAM STARTED FROM A .SAV FILE
↑SAVDON: 0		;FLAG INDICATING PROGRAM HAD BEEN SAVED AT LEAST ONCE
ACS:	BLOCK 20	;REGISTER SAVE AREA
↑SWPTBL:SIXBIT /DSK/	;DEVICE FOR SWAP
	SIXBIT /SAV/	;FOR FILENAME
	SIXBIT /SAV  !/	;FILENAME.SAV (SAVE SEGMENT ALSO)
	XWD 0,RETR 	;CORE SIZE (0=USE WHAT YOU NEED)
	0		;END OF LIST
BEND    SAVER
SUBTTL Storage Management

;GET BLOCK OF FREE STORAGE
;CALL WITH -SIZE IN T, RETURNS ADDRESS IN T, CLOBBERS 0
GFS:	PUSH P,A	;SAVE A
	HRRO A,T	;TO BE SURE (AND TO NOT MUNG T YET)
	ADD A,BEGFREE	;DECREMENT BEGINNING OF FREE STORAGE. *****
	TLNE A,777777
	PUSHJ P,DRYROT	;BUG TRAP
	CAMG A,JOBFF	;ROOM LEFT?	****
	COREFULL	;NO, LET'S SEE IF WE CAN GET SOME
	JRST GFS+1	;WE GOT MORE SPACE! TRY AGAIN
	MOVEM A,BEGFREE	;RETURN ADDRESS IN T	*****
	EXCH A,T
	POP P,A		;RESTORE A
	POPJ P,

;GET BLOCK OF PERMANENT STORAGE
;CALL WITH SIZE IN T, RETURNS ADDRESS IN T
GPS:	HRRZ T,T	;JUST IN CASE...
	ADD T,JOBFF	;ADD TO TOP OF PERMANENT STORAGE
	CAML T,BEGFREE	;*****
	COREFULL	;NO, LET'S SEE IF WE CAN GET SOME
	JRST GPS+2	;WE GOT MORE SPACE! TRY AGAIN
	HRLM T,JOBSA
	EXCH T,JOBFF	;RETURN ADDRESS IN T	*****
	POPJ P,

.CORFL:	PUSH P,0	;SAVE AC0
	MOVE JOBREL	;IS FREE STORAGE IN USE?
	CAME BEGFREE
	JRST [		;YES, BARF!
		SETOM GETMORE	;SET FLAG TO GET CORE UPON RESTART
		MOVE -1(P)
		MOVEM LSTFUL	;SAVE ADDRESS OF CALLER FOR DEBUGGING
		POP P,0
		ERROR <Storage full!>
		POPJ P,]
	SKIPN NOMSG		;Don't print if in quiet mode
	OUTSTR[ASCIZ/
Getting more core.../]	;NO, LET'S GET SOME MORE
	MOVE JOBREL
	ADDI 2000
	CORE
	JRST [	ERROR<Can't expand core!>
COMMENT ⊗ Could get enough core.  You lose. ⊗;
		JRST .CORFL]
	MOVE JOBREL
	MOVEM BEGFREE
	SKIPN NOMSG
	OUTSTR[ASCIZ/
/]
	POP P,0
	AOS (P)
	POPJ P,

;CALLED FROM INIDAC
SETCOR:	CORE
	JRST [	ERROR<Can't expand core>
		HALT $.]
	MOVE JOBREL
	MOVEM BEGFREE
	POPJ P,

;SIXOUT and PRTFLN
SIXOUT:	HRLI 440600	;MAKE BYTE POINTER
LOOPTS:	SOJL T1,OTTYRT	;IF DONE, FLUSH TTY BUFFER
	ILDB T,0
	JUMPE T,OTTYRT
SIXOU3:	ADDI T,40
	TYPCHR T
	JRST LOOPTS
;PRINT FILE NAME
PRTFLN:	MOVEI T1,6
	MOVE -1(P)	;GET ADDRESS OF FILE NAME
	PUSHJ P,SIXOUT
	ADDI 1		;LOOK AT FILE NAME
	HLRZ T1,@0	;GET EXTENSION
	JUMPE T1,PRTFL1	;DON'T PRINT NULL EXTENSION
	TYPCHR ["."]
	MOVEI T1,3
	PUSHJ P,SIXOUT
PRTFL1:	TYPCHR ["["]
	MOVE -1(P)
	ADDI 3
	SKIPN @0
	JRST [	SETZ T1,
	             DSKPPN T1,
		MOVEM T1,@0
		JRST PRTFL2]
PRTFL2:
	HRLI 440600	;MAKE BYTE POINTER
	PUSHJ P,[PRTFL3: MOVEI T1,3
			 ILDB T,0
			 SOJL T1,OTTYRT	;IF DONE, FLUSH TTY BUFFER
			 JUMPE T,PRTFL3+1
			 JRST SIXOU3]
 
	TYPCHR [","]
	HRLI 220600	;BYTE POINTER TO MIDDLE OF PPN
	PUSHJ P,PRTFL3
	TYPCHR ["]"]
	SUB P,[XWD 2,2]
	JRST @2(P)

TXTOUT:	0
	TYPSTR @0
	JRST @TXTOUT

;PRINT SYMBOL TABLE ENTRY IN ENTITY IN A
PRNTSYM:HRRZI @A	;GET SYMBOL
 	ADD [440577777777]	;MAKE A 6 BIT POINTER
	ILDB T1,	;GET LENGTH OF SYMBOL
	SUBI T1,5	;HOW MANY IN SECOND PART
	PUSH P,T1	;SAVE FOR LATER
	MOVEI T1,5	;CHARACTER COUNT
	PUSHJ P,PRNTS2	;SIXBIT OUTPUT ROUTINE
	POP P,T1	;RECOVER CHARACTER COUNT
	ADDI 0,1	;SKIP GOODBITS WORD
	JUMPLE T1,OTTYRT;DON'T BOTHER IF COUNT<1
	HRLI 000600	;ANOTHER POINTER
	PUSHJ P,PRNTS2
OTTYRT:	OUTPUT TTY,	;FLUSH TTY BUFFER
	POPJ P,
PRNTS2:	SOJL T1,CPOPJ
	ILDB T,0
	JUMPE T,CPOPJ
	ADDI T,40
	CAIN T,"." 	;MAP '.` INTO '_`
	MOVEI T,"_"
	TYPCHR T
	JRST PRNTS2

DCLMSG:	SKIPE NOMSG
	JRST DCLRET
	MOVE BLEVEL		;INDENT ACCORDING TO NUMBER OF BLOCKS DEEP
	SOJL 0,[MOVE @(P)	;GET STRING
		TYPSTR @0	;PRINT IT FOLLOWED BY
		PUSHJ P,PRNTSYM	;IDENTIFIER
		TYPSTR [ASCIZ/
/]				;AND A CRLF
	DCLRET:	AOS (P)
		POPJ P,]
	TYPCHR [" "]		;TWO SPACES PER LEVEL
	TYPCHR [" "]
	JRST DCLMSG+1
;RDBUF - READ A BUFFER
RDBUF:	MOVSI A,'TTY'
	CAME A,DNAM	;IS INPUT DEVICE A TTY ?
	TLO FL,NOSTAR	;NO. SUPRESS THE *.
	TLZN FL,NOSTAR	;PRINT IF NOSTAR NOT ON.
	OUTSTR [ASCIZ/
>/] 			;YES. TYPE CR LF *.
	USETI DT,@RECCT ;POSITION INPUT FILE TO RIGHT RECORD.
        AOS   RECCT     ;ADD 1 TO RECORD CTR
	SETOM NOISCP#	;Set flag saying ISCP is invalid
	IN DT,0		;READ NEW INPUT BUFFER.
	JRST RDBUF2	;OK, SET IT UP
	STATZ DT,20000	;ERROR, END OF FILE SEEN ?
	JRST SETUP	;YES.
	WARN <INPUT ERROR>
RDBUF2:	MOVEI 4		;MAKE SURE 0 WORD TERMINATBES IT.
	ADD ICCNT	;CHAR. COUNT +4/5 IS WORD COUNT.
	MOVEI A,5	;BECAUSE WE DON'T WANT TO LOSE B.
	IDIVM A		;SEE? NO RANDOM REMAINDER !!
	ADD A,SCP	;ADD  BASE ADDRESS.
	IBP A		;BAGBITING SYSTEM.
	SETZM (A)	;ZERO IT.
	MOVE SCP
	MOVEM ISCP#	;SAVE FOR ERROR PRINTOUT.
	SETZM NOISCP	;Clear flag saying ISCP is invalid
	POPJ P,
SUBTTL Numeric Output Routines
BEGIN NUMOUT

;OUTPUT IN OCTAL
↑OUTOCT: EXCH A,(P)	;SAVE A, GET RET. ADR.
	EXCH A,-1(P)	;SAVE RET. ADR., GET ARG.
	PUSH P,B	;SAVE B
	SETZ B,
	PUSHJ P,OUTOC2
	OUTPUT TTY,	;FLUSH TTY BUFFER
	POP P,B
	POP P,A
	POPJ P,
OUTOC2:
;	IDIVI A,8	;PRINT OCTAL NUMBER FROM A.
	LSHC A,-3
	ROT B,3
	HRLM B,(P)	;SAVE LOW ORDER DIGIT.
	SKIPE A		;DONE ?
	PUSHJ P,OUTOC2	;NO. RECUR FOR REST OF DIGITS.
	HLRZ B,(P)	;YES. GET HIGH ORDER DIGIT.
	ADDI B,"0"	;CONVERT TO ASCII.
	TYPCHR B	;OUTPUT DIGIT
	POPJ P,

;CALL WITH NUMBER TO BE PRINTED IN A
;CLOBBERS A-B
↑DECPNT: PUSH P,C	;SAVE C
	JUMPGE A,.+4	;NEGATIVE
	MOVNS A		;YES
	MOVEI B,"-"	;OUTPUT A "-"
	PUSHJ P,TTYCHR
	PUSH P,[DECRET];SET UP RETURN
	MOVNI C,1	;SET FAKE DECIMAL POINT
	JRST FLTOU3	;JUMP INTO FLOATING CHARACTER
DECRET:	POP P,C
	MOVEI B,40
	PUSHJ P,TTYCHR
	JRST OTTYRT	;OUTPUT TTY BUFFER AND RETURN

↑OUTFLT: PUSH P,C	;SAVE C
	JUMPE A,DECPNT+1;TEST FOR ZERO
	MOVEI C,7	;INIT. EXPONENT
	JUMPGE A,.+4	;NEGATIVE NUMBER?
	MOVNS A		;NEGATE NUMBER
	MOVEI B,"-"	;OUTPUT A "-"
	PUSHJ P,TTYCHR
	TLNN A,377000	;IS IT FLOATING?
	JRST DECPNT+1	;NO! USE DECPNT
	CAML A,[999999.5]	;NORMALIZE
	JRST .+3
	FMPR A,[10.0]
	SOJA C,.-3
	CAMGE A,[9999999.5]
	JRST .+3
	FDVR A,[10.0]
	AOJA C,.-3
	CAIG C,7	;WILL IT FIT IN FIXED POINT?
	JUMPGE C,FLTOU2	;IF DEC. EXP. BETWEEN -1 AND 5, YES
	SUBI C,1	;TURN INTO ACTUAL EXP.
	PUSH P,C	;SAVE EXPONENT
	MOVEI C,1
	PUSHJ P,FLTOU6	;CALL SELF TO OUTPUT MANITISSA
	MOVEI B,"E"	;OUTPUT "E" (FOR EXPONENT!)
	PUSHJ P, TTYCHR
	POP P,A		;GET REAL C
	JRST DECPNT+1	;CALL INTEGER OUTPUT TO RETURN IT
FLTOU2:	JUMPN C,.+3	;DEC. EXP =-1
	PUSHJ P,FLTOU5	;PRINT "0."
	PUSHJ P,FLTOU4
	PUSHJ P, FLTOU6	;OUTPUT MANTISSA
	SOJL C,DECRET	;IF POSITIVE, PRINT TRAILING ZEROS
	PUSHJ P,FLTOU5
	JRST .-2
FLTOU6:
	FIXR A,A	;FIX THE MANTISSA
	IDIVI A,=10
	JUMPE A,FLTOU3+1;IN CASE OF POWERS OF 2
	JUMPE B,.-2	;IGNORE TRAILING ZEROS
	JRST .+2	;SKIP THE DIVIDE
FLTOU3:	IDIVI A,12	;PRINT DECIMAL INTEGER FROM A.
	HRLM B,(P)	;SAVE LOW ORDER DIGIT.
	SKIPE A		;DONE ?
	PUSHJ P,FLTOU3	;NO. RECUR FOR REST OF DIGITS.
	HLRZ B,(P)	;YES. GET HIGH ORDER DIGIT.
	ADDI B,"0"	;CONVERT TO ASCII.
	SOJN C,TTYCHR	;DECIMAL POINT?
	PUSHJ P,TTYCHR	;OUTPUT DIGIT
FLTOU4:	MOVEI B,"."	;AND "."
	JRST TTYCHR
FLTOU5:	MOVEI B,"0"	;PRINT A ZERO
TTYCHR:	TYPCHR B
	POPJ P,
BEND	NUMOUT
;   Read number from TTY
GETNUM:	PUSH P,0	;SAVE 0
	SETZ 1,
	INCHWL
	CAIN 15
	JRST [	INCHWL	;EAT THE LINE FEED
		POP P,0	;RESTORE 0
		POPJ P,];RETURN
	SUBI "0"
	IMULI 1,=10
	ADD 1,0
	CAIG =9
	JUMPGE GETNUM+2
	OUTSTR [ASCIZ/ILLEGAL CHARACTER IN NUMBER
/]
	JRST GETNUM+1
;*****************************************************************
COMMENT ⊗	 Character string conversion package


This  package   is  a  collection   of  frequently   used  conversion
subroutines, such as  convert integer to character stream and convert
character  stream  to  sixbit.    The  character  stream   source  or
destination  are   defined  by  a   PDP-10  instruction,     such  as
PUSHJ P,GETCHR.   All  character stream destinations  are expected to
return  a  character  in  accumulator  1  and  all  character  stream
destination are  expected to recieve its character  in accumulator 1.
Subroutines which return arguments  always return their arguments  in
accumulator 1 and  if a break character is  to be return, it  will be
in accumulator  0.   Character streams  should not  modify any  other
accumulators.  These subroutines are:


RDINT(Integer BASE; Character_source OPCODE);
   Convert character stream into integer, in specified base.

WRINT(Integer N, BASE; Character_destination OPCODE);
   Convert integer into character stream, in specified base.

RDSIX(Integer SIXBIT; Character_source OPCODE, Breaktable BRKTAB);
   Convert sixbit word into character stream.

WRSIX(Integer SIXBIT; Character_destination OPCODE);
   Convert sixbit word into character stream.

RDFLO(Operation OPCODE);
   Convert character stream into real, in specified base. (UNIMPLIMENTED)

WREFLO(Real N,CHARACTER_COUNT,CONTROL_WORD; Character_destination
	 OPCODE);
 Convert  floating point  number into  character stream of  specified
format.   CONTROL_WORD is of  form. (See FORTRAN for  details on this
format).
	XWD <characters to left of decimal point>,<width of field>

RDFILN(Array FILBLK; Character_source OPCODE; Sixbit
	DEFAULT_EXTENSION)
   Convert a character string into system file name structure.

WRFILN(Array FILBLK; Character_destination OPCODE)
   Convert system file name structure into a character string.

WRASCZ(Ascizstring S; Character_destination OPCODE)

A  break  table  is  the  standard  system  format  four  word  table
representing which  characters are break characters.   See UUO Manual
for details.  Briefly,

	Word 0 contains bits for <null> thru #,
	Word 1 contains bits for $ thru G,
	Word 2 contains bits for H thru k
	Word 3 contains bits for l thru <bs>

Note: LIBRARY.TMP should be a copy of either HEADER.FAI or EXPHD.FAI
⊗;

;;ENTRY RDIOSP			↔  TITLE RDIOSP ↔EXTERNAL RDSIX
; Read a device name and file name into DEVBLK, returning terminator
;    in AC 0 and AC 1.  Default extension is used if none is given.
; Skip return if successful.  If no device or file is given,  do not
;    alter DEVBLK and non-skip return
;DEVBLK: SIXBIT/DEVNAM/
;	 XWD OUTPTR,INPTR
;	 SIXBIT/FILNAM/
;	 SIXBIT/EXT/
;	 0
;	 SIXBIT/PRJPRG/
RDIOSP:	PUSH 17,2
	MOVE 2,-4(17)
	MOVSI 1,446353	;DSKM	; FOR IRCAM*******************
	MOVEM 1,(2)
	PUSHJ 17,RDIOSP+50	;Read SIXBIT
	JUMPE 1,RET
	CAIE 0,":"
	JRST NODEV
	MOVEM 1,(2)		;Set device name
	PUSHJ 17,RDIOSP+50
NODEV:	MOVEM 1,2(2)
	HLLZ 1,-2(17)			;Fetch default extension
	MOVEM 1,3(2)
	SETZ 1,
	CALLI 1,24
	MOVEM 1,5(2)
	CAIE 0,"."		;Extension coming?
	JRST NOTEXT
	PUSHJ 17,RDIOSP+50	;Yes, read it
	HLLZM 1,3(2)
NOTEXT:	CAIE 0,"["		;PPN coming?
	JRST SKRET    		;No, return
	PUSH 17,RDIOSP+60      		;Read project
	PUSH 17,-4(17) 
	PUSHJ 17,RDINT		;(Stanford likes it PPN's right justified)
	HRLM 1,5(2) 
	CAIE 0,","
	JRST NOTCOM   			;Assume he wants same programmer area
	PUSH 17,RDIOSP+60      		;Read project
	PUSH 17,-4(17) 
	PUSHJ 17,RDINT		;(Stanford likes it PPN's right justified)
	HRRM 1,5(2) 
NOTCOM:	CAIE 0,"]"			;Don't worry if no ']'
	JRST RDIOSP+44
	XCT -3(17)
	MOVE 0,1
;Skip return
SKRET:	AOS -1(17)
;Non-skip return
RET:	MOVE 1,0
	POP 17,2
	JRST POP3J.
	PUSH 17,-4(17) 
	PUSH 17,RDIOSP+61
	PUSHJ 17,RDSIX
	POPJ 17,0   
	-11	;;.PLEVEL←←.PLEVEL+2	;(Set stack level for subr)
;Read sixbit with appropriate break characters
RDFIL1:	FDVRB 16,37600	;;CALL(RDSIX,OPCODE,[FILBRK])
	374000		;;POP0J
	7,,600000
	10
	RDIOSP+54 
 
POP1J.:	SUB 17,POP4J.+2
	JRST @2(17)
POP2J.:	SUB 17,POP4J.+3
	JRST @3(17)
POP3J.:	SUB 17,POP4J.+4
	JRST @4(17)
POP4J.:	SUB 17,POP4J.+5
	JRST @5(17)
	2,,2
	3,,3
	4,,4
	5,,5
;;ENTRY WRIOSP			↔  TITLE WRIOSP ↔EXTERNAL WRSIX
;;.INSERT LIBRARY.TMP
;;NSUBR WRIOSP,DEVBLK,OPCODE
;;	ACCUMULATORS{2,P2}
WRIOSP:	PUSH 17,2
	EXCH 3,-3(17)
	MOVSI 2,440603
LOOP1:	ILDB 1,2
	JUMPE 1,CONT1
	ADDI 1,40
	XCT -2(17)
CONT1:	CAMN 2,WRIOSP+43
	JRST WRIA
	CAMN 2,WRIOSP+44        
	JRST WRIB
WRIC:	CAMN 2,WRIOSP+45
	JRST LOOP1
EXTDON:	SKIPN 5(3)
	JRST PPNDON   
	MOVEI 1,"["
	XCT -2(17)
	HLRZ 5(3)
	PUSH 17,0
	PUSH 17,WRIOSP+42
	PUSH 17,-4(17)
	PUSHJ 17,WRINT
	MOVEI 1,54
	XCT -2(17)
	HRRZ 5(3)
	PUSH 17,0
	PUSH 17,WRIOSP+42
	PUSH 17,-4(17)
	PUSHJ 17,WRINT
	MOVEI 1,135
	XCT -2(17)

PPNDON:	EXCH 3,-3(17)
	POP 17,2
	JRST POP2J.
	10
	603,,0
	603,,2
	IMUL 14,3(3)
WRIB:	HLLZ 1,3(3)
	JUMPN 1,.+2
	JRST EXTDON    
	MOVEI 1,56
	XCT -2(17)
	JRST WRIC
WRIA:	ADDI 2,1
	MOVEI 1,72
	XCT -2(17)
	JRST LOOP1
;;ENTRY RDINT			↔  TITLE RDINT
;;.INSERT LIBRARY.TMP
;Subroutines RDINT,WRINT
;;NSUBR RDINT,BASE,-2(17)
RDINT:	SETZ 0,
LOOP:	XCT -1(17)
	CAIL 1,"0"
	CAILE 1,"9"
	JRST RDI
	IMUL -2(17) 
	ADDI 0,-60(1)
	JRST LOOP
RDI:	EXCH 1
	JRST POP2J.
 
;;ENTRY WRINT			↔  TITLE WRINT
;;.INSERT LIBRARY.TMP
;;NSUBR WRINT,INTEGER,BASE,-2(17)
;  Convert integer into character stream, in specified base.
WRINT:	MOVE 1,-3(17)	;FETCH ARG AND MOVE RET. ADR.
	POP 17,-3(17)
	POP 17,WRINT+26
	POP 17,WRINT+25
	PUSH 17,2
	PUSH 17,WRINT+27
L1:	JUMPGE 1,L2			;TEST FOR NEGATIVE NUMBER.
	MOVM 2,1			;PRINT MINUS SIGN.
	MOVEI 1,"-"
	XCT WRINT+26
	MOVE 1,2
L2:	IDIV 1,WRINT+25 	;MODULO TEN AND SAVE.
	HRLM 2,0(17)
	SKIPE 1
	PUSHJ 17,WRINT+13
	HLRZ 1,0(17)
	ADDI 1,60
	XCT WRINT+26			;RESTORE & PRINT.
	POPJ 17,0
RETX:	POP 17,2
	POPJ 17,0
	0
	0
	WRINT+23
;;ENTRY RDSIX			↔  TITLE RDSIX
;;.INSERT LIBRARY.TMP
;;NSUBR RDSIX,-2(17),BRKTAB
; Read SIXBIT, where BRKTAB is address of 4 word bit table indicating what
;    characters are terminators.
; If there are more than 6 characters, additional characters are ignored.
;
; Returns SIXBIT in 1
;   Terminating character in 0.
;;	ACCUMULATOR{T1,2}
RDSIX:	PUSH 17,2		;Save AC's we'll need
	PUSH 17,3
	MOVSI 3,440600        	;Pointer to where SIXBIT will go
	SETZ 0,
LOOPX:	XCT -4(17)		;Pick up a character
	PUSH 17,1
	IDIVI 1,=36
	ADD 1,-4(17)
	MOVE 1,(1)
	LSH 1,(2)
	JUMPL 1,RETZ		;1 means terminator
	POP 17,1
	CAIGE 1,"a"
	SUBI 1,40
	CAME 3,RDSIX+26      	;Check for more than 6 characters
	IDPB 1,3		;Pack into word
	JRST LOOPX
RETZ:	MOVE 1,0		;Get SIXBIT to return
	POP 17,0		;Get back terminator
	POP 17,3		;Restore saved AC's
	POP 17,2		;Restore saved AC's
	JRST POP2J.
	600,,0
 
;;ENTRY WRSIX			↔  TITLE WRSIX
;;.INSERT LIBRARY.TMP
;;NSUBR WRSIX,SIX,-2(17)
;  Convert sixbit word into character stream.
WRSIX:	PUSH 17,0
	MOVEI 0,6
	PUSH 17,WRSIX+12
LOOPW:	ILDB 1,(17)
	ADDI 1,40
	XCT -3(17)
	SOJG LOOPW
	POP 17,0
	POP 17,0
	JRST POP2J.
	ANDCB 14,-3(17)
SWBRK:	-1				;<null> thru #
	BYTE (29) -1 (7)0		;$ thru G,
	BYTE (19) 0 (6) -1 (11) 0	;H thru k
	BYTE (15) 0 (5) -1		;l thru <bs>
SUBTTL	Tables and Flags

PLIST:	BLOCK LPLIST
PDLIOWD:IOWD LPLIST,PLIST

OSTK:	BLOCK LOSTK

RQ1:	BLOCK LRQ	;THE RUN QUEUE, CLOUMN ONE.
RQ2:	BLOCK LRQ	;COLUMN TWO.

;;PATCH:	BLOCK 50	;LET'S HEAR IT FOR DEBUGGING!

;Symbol table pointers
BUCTBL:	FOR I←0,BUCKNO-1,1 < CAT(SYM,→I)↔ >
STRBUC: 0		;HEAD OF STRING TABLE
NUMBUC: EXP C		;HEAD OF NUMBER TABLE
OUTFIL:	NULLDV		;Pointer to default output specification, initially undefined
INFILE:	0     		;NAME FOR READIN FILE 1
INFIL2:	0     		;NAME FOR READIN FILE 2
INFIL3:	0     		;NAME FOR READIN FILE 3
INFIL4:	0     		;NAME FOR READIN FILE 4

;A COPY OF ABOVE FOR RESET COMMAND
SVAREA:	FOR I←0,BUCKNO-1,1 < CAT(SYM,→I)↔ >
	0		;FOR STRBUC
	C		;FOR NUMBUC
	NULLDV		;FOR POUTSP

IARR1:		;; HERE BEGINS AN AREA WHICH IS ZEROED DURING
		;; INITIALIZATION OF EACH COMPILATION.

UOTBL:	BLOCK LUOTBL

ACS:
RACS:	BLOCK 20	;R-TIME AC TABLE
IACS:	BLOCK 20	;I-TIME AC TABLE

; THE FOLLOWING FLAGS MUST BE PUSHED AND MAY NOT BE BITS
; THESE ARE INITED TO 0
IONLY:	0	;FLAG TO GENERATE ONLY I-TIME CODE
BLEVEL:	0	;BLOCK LEVEL
RSTATE:	0	;USED TO SET R-TIME ATTRIBUTES OF STATEMENT LISTS
NOTAC0:	0	;FLAG INDICATING NOT TO USE AC0
LOGFLG:	0	;IF 0 THEN TREAT '<` AS A COMMENT
UGEXPF:	0	;SET WHEN WE WANT A U.G. TO RETURN A VALUE

UOPTR:	-1	;COUNT OF U SYMBOLS
IARR2:

; THESE GET SET TO -1 
DONEFX: -1	;FIXUP FOR WHILE-UNTIL-FOR LOOPS
	-1
EXITFX:	-1	;FIXUP FOR BLOCK EXITS
	-1
RETFIX:	-1	;FIXUP FOR RETURN STATEMENTS (ALWAY I-TIME CODE)

IARR5:

;	PBASE(INSXR)	;SO THAT P MAY BE AN ARRAY
 	XWD INSXR,PBASE	;FW strikes again!  FAIL once accepted the above line
	LPA		;SIZE OF P ARRAY
IARR4:
PBASE:	BLOCK LPA

OUTA:	0	;CHANNEL A OUTPUT SAMPLE ACCUMULATED HERE.
OUTB:	0	;CHANNEL B.
OUTC:	0	;CHANNEL C.
OUTD:	0	;CHANNEL D.

IARR3:

VLOC:	0
ILOC:	0
RLOC:	0

;DEBUGGING STUFF
LSTWRD:	BLOCK 3	;LAST WORD OF CODE EMITTED
↓LSTLOA:0	;LAST PLACE CODE WAS LOADED

NULLDV:	ASCIZ//	;No device, used to indicate MUSCMP to explicitly ask for it

	VAR
	LIT
MUSEND:	END GO